home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / mpl17ds.zip / RBBSSUB5.BAS < prev    next >
BASIC Source File  |  1989-06-12  |  68KB  |  1,957 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB5.BAS CPC17-1D, Copyright 1986 - 89 by D. Thomas Mack'
  3. '  Copyright 1987 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB5.BAS
  5. '  Written by .........: D. Thomas Mack
  6. '  First Released .....: September 18, 1988
  7. '  Subsequent Releases.: OCT 30 , 1988
  8. '  Copyright ..........: 1986, 1987, 1988
  9. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  10. '                        RBBS-PC.BAS utilizes a lot of common subroutines.
  11. '                        Those that do not require error trapping are
  12. '                        incorporated within RBBSSUB2.BAS, RBBSSUB3.BAS,
  13. '                        RBBSSUB4.BAS and RBBSSUB5.BAS as separately
  14. '                        callable subroutines in order to free up as much
  15. '                        code as possible within the 64K code segment
  16. '                        used by RBBS-PC.BAS.
  17. '  Parameters..........: Most parameters are passed via a COMMON statement.
  18. '
  19. ' Subroutine  Line               Function of Subroutine
  20. '   Name     Number
  21. '  FILESYS    20100   File System for RBBS-PC
  22. '
  23. '  $INCLUDE: 'RBBS-VAR.BAS'
  24. '
  25. ' $SUBTITLE: 'FILESYS -- subroutine for RBBS-PC's file system'
  26. ' $PAGE
  27. '
  28. ' SUBROUTINE NAME    -- FILESYS
  29. '
  30. ' INPUT PARAMETERS   --       PARAMETER                 MEANING
  31. '                       FILESYS.PARAMETER = 1  LIST THE SYSOP'S COMMENTS FILE
  32. '                                           2  L)IST DIRECTORY COMMAND
  33. '                                           3  D)OWNLOAD COMMAND
  34. '                                           4  RETURN FROM EXTERNAL PROTOCOLS
  35. '                                           5  U)PLOAD COMMAND
  36. '                                           6  S)CAN DIRECTORY COMMAND
  37. '                                           7  P)ERSONAL FILES COMMAND
  38. '                                           8  N)EW FILES COMMAND
  39. '                                           9  RETURN FROM EXTENDED DESCRIPTION
  40. '
  41. ' OUTPUT PARAMETERS  -- FILESYS.PARAMETER = 1  COMMAND PROCESSED SUCCESSFULLY
  42. '                                           2  RECYCLE TO TOP OF RBBS-PC (202)
  43. '                                           3  PROCESS NEXT COMMAND (1200)
  44. '                                           4  DENY USER ACCESS (1380)
  45. '                                           5  HANDLE EXTENDED DESCRIP. (2008)
  46. '                                           6  USER'S TIME EXCEEDED (10553)
  47. '                                           7  CARRIER DROPPED (10595)
  48. '
  49. ' SUBROUTINE PURPOSE -- TO HANDLE THE RBBS-PC FILE SYSTEM COMMANDS
  50. '
  51.       SUB FILESYS STATIC
  52.       FF = FILESYS.PARAMETER
  53.       FILESYS.PARAMETER = 1
  54.       ON FF GOSUB 20119, _  ' HANDLER TO LIST COMMENTS TO SYSOP
  55.                   20150, _  ' L)IST DIRECTORY COMMAND HANDLER
  56.                   20180, _  ' D)OWNLOAD COMMAND HANDLER
  57.                   20262, _  ' RETURN FROM EXTERNAL PROTOCOL'S
  58.                   20400, _  ' U)PLOAD COMMAND HANDLER
  59.                   21800, _  ' S)CAN DIRECTORY COMMAND HANDLER
  60.                   21850, _  ' P)ERSONAL FILES COMMAND HANDLER
  61.                   21860, _  ' N)EW FILES COMMAND HANDLER
  62.                   20705     ' RETURN FROM EXTENDED DESCRIPTIONS
  63.         GOTO 21920                                                ' JM110801
  64. '      ON FILESYS.PARAMETER GOTO 21920, _ ' NORMAL EXIT
  65. '                                21570, _ ' RECYCLE TO TOP OR RBBS-PC
  66. '                                21580, _ ' PROCESS NEXT COMMAND
  67. '                                21590, _ ' DENY USER ACCESS
  68. '                                21600, _ ' HANDLE EXTENDED DESCRIPTIONS
  69. '                                21610, _ ' USER'S TIME EXCEEDED
  70. '                                21620    ' CARRIER DROPPED
  71. 20119 EC = 0
  72.       GOTO 20122
  73. '
  74. ' *****  SCAN DIRECTORIES (PRINT TEXT)  *****
  75. '
  76. '  (formerly lines 7000 to 7260 in RBBS-PC.BAS CPC16-1A
  77. 20120 A$ = CX$(2)+"Scanning"+CX$(3)+" Directory "+CX$(5) + _
  78.            FILE.NAME.HOLD$ +CX$(3)+ _
  79.            " for " +CX$(7)+ _
  80.            RS$
  81.       GOSUB 21650
  82.       IF FILESYS.PARAMETER > 1 THEN _
  83.          RETURN
  84.       PG = TRUE
  85. 20122 CALL OPENWORK (FILE.NAME$)
  86.       IF EC = 53 THEN _
  87.          CALL UPDTCALR ("Missing File " + FILE.NAME$,2) : _
  88.          A$ = "Missing file " + _
  89.               FILE.NAME$ + _
  90.               ". Please tell SYSOP" : _
  91.          GOSUB 21650 : _
  92.          RETURN
  93. 20124 CALL CARRIER
  94.       IF EOF(2) OR _
  95.          (SUBROUTINE.PARAMETER = -1  AND NOT LOCAL.USER) THEN _  'JM110801
  96.          GOTO 20142
  97. 20126 CALL READDIR (1)
  98.      IF EC <> 0 THEN _
  99.         EL = 20126 : _
  100.         GOTO 21900
  101.      IF CK = 0 THEN _
  102.         GOTO 20140
  103.      IF LEN(A$) > 0 THEN IF ASC(A$) = 32 THEN _
  104.         IF LAST.OK AND NOT EXTENDED.OFF THEN _
  105.            GOTO 20140 _
  106.         ELSE GOTO 20124
  107.      LAST.OK = FALSE
  108. 20128 IF CK > 1 THEN _
  109.          IF WILD.SEARCH THEN _
  110.             A = INSTR(A$," ") : _
  111.             IF A = 0 THEN _
  112.                GOTO 20124 _
  113.             ELSE Z$ = LEFT$(A$,A - 1) : _
  114.                  CALL WILDFILE (RS$,Z$,XXX) : _
  115.                  GOTO 20136_
  116.          ELSE Z$ = A$ : _
  117.               CALL ALLCAPS (Z$) : _
  118.               XXX = (INSTR(Z$,RS$) = 0) : _
  119.               GOTO 20136
  120. 20130 A = INSTR(9,MID$(A$,1,32),"/")
  121.       IF A = 0 THEN _
  122.          A = INSTR(9,MID$(A$,1,32),"-")
  123. 20132 IF A < 3 THEN _
  124.          GOTO 20124
  125.       IF INSTR("0123456789",MID$(A$,A - 1,1)) = 0 THEN _
  126.          GOTO 20124
  127.       A = A - 2
  128.       WK$ = RIGHT$(MID$(A$,A,8),2) + _
  129.             LEFT$(MID$(A$,A,8),2) + _
  130.             MID$(MID$(A$,A,8),4,2)
  131.       IF MID$(WK$,3,1) = " " THEN _
  132.          MID$(WK$,3,1) = "0"
  133.       IF MID$(WK$,5,1) = " " THEN _
  134.          MID$(WK$,5,1) = "0"
  135. 20134 XXX = (WK$ < RS$)
  136. 20136 IF XXX THEN _
  137.          GOTO 20124
  138.       IF PG THEN _
  139.          PG = FALSE : _
  140.          CALL OPENWORK (FILE.NAME$) : _
  141.          Q = 0 : _
  142.          GOTO 20124
  143. 20138 IF PG THEN _
  144.          GOTO 20124
  145. 20140 LAST.OK = TRUE
  146.       GOSUB 21650
  147.       IF FILESYS.PARAMETER > 1 THEN _
  148.          RETURN
  149.       CALL ASKMORE ("",TRUE,TRUE,LIST.INDEX,FALSE)
  150.       IF NO THEN _
  151.          EC = 0 : _
  152.          RETURN
  153.       IF NOT RET THEN _
  154.          GOTO 20124
  155. 20142 Q = 0
  156.       CLOSE 2
  157.       CALL CARRIER
  158.       IF SUBROUTINE.PARAMETER = -1 THEN _
  159.          FILESYS.PARAMETER = 7
  160.       RETURN
  161. '
  162. ' *  L - COMMAND FROM FILES MENU (LIST DIRECTORY)                             *
  163. '
  164. 20150 LIST.DIRECTORY = TRUE
  165.       LIST.NEW = FALSE
  166.       SEARCH.DATE$ = ""
  167.       SEARCH.STRING$ = ""
  168.       SEARCHING.ALL = FALSE
  169.       SHOW.DIR.OF.DIR = NOT EXPERT.USER
  170.       CK = 0
  171.       IF Q > 1 THEN _
  172.          CALL ALLCAPS (B$(2)) : _
  173.          IF B$(2) = "L" THEN _
  174.             SHOW.DIR.OF.DIR = TRUE _
  175.          ELSE LIST.INDEX = 2 : _
  176.               GOTO 20159
  177. 20158  IF DOWNLOAD.COMPLETED AND AUTO.END = 1 THEN _
  178.         FILESYS.PARAMETER = 7: _
  179.         RETURN
  180.        IF LIST.NEW OR LIST.INDEX > 255 THEN _
  181.          LIST.INDEX = 0 : _
  182.          RETURN
  183.       LIST.INDEX = 1
  184.       CALL GETDIRS (SHOW.DIR.OF.DIR)
  185.       IF Q = 0 THEN _
  186.          RETURN
  187.       SHOW.DIR.OF.DIR = FALSE
  188. 20159 CALL CONVDIRS (LIST.INDEX)
  189.       QX = Q
  190. 20160 CALL CARRIER
  191.       IF SUBROUTINE.PARAMETER = -1 THEN _
  192.          FILESYS.PARAMETER = 7 : _
  193.          RETURN
  194.       IF LIST.INDEX <= QX THEN _  
  195.         GOTO 20161
  196.       IF NO OR (FILE.NAME.HOLD$ = DIRECTORY.PREFIX$) THEN _
  197.          REDIM A$(ADIM) : _
  198.          REDIM B$(ADIM) : _
  199.          GOTO 20158
  200.       CALL QTPUT (EMPHASIZE.OFF$,0)
  201.       A$ = "End list..  R)elist, [Q]uit, or File Names to Download"
  202.       GOSUB 21660
  203.       IF FILESYS.PARAMETER > 1 THEN _
  204.          RETURN
  205.       CALL ALLCAPS (B$(1))
  206.       IF B$(1) = "R" THEN _
  207.          LIST.INDEX = LIST.INDEX - 1 : _
  208.          B$(LIST.INDEX) = A1$ : _
  209.          GOTO 20161
  210.       IF LEN(B$(1)) > 1 AND _
  211.          USER.SECURITY.LEVEL >= OPT.SEC(19 - 20 * (MENU.INDEX = 6)) THEN _
  212.          B = 1 : _
  213.          GOSUB 20202 : _
  214.          IF FILESYS.PARAMETER > 1 THEN _
  215.             RETURN _
  216.          ELSE CALL LINE25
  217.       GOTO 20158
  218. 20161 IF INSTR(B$(LIST.INDEX),".") THEN _
  219.          GOTO 20172
  220.       VIOLATION$ = "List Dir. "
  221.       Z$ = B$(LIST.INDEX)
  222.       A = INSTR("E+E-E",Z$)
  223.       IF A > 0 THEN _
  224.          IF A = 5 THEN _
  225.             EXTENDED.OFF = NOT EXTENDED.OFF : _
  226.             GOTO 20175 _
  227.          ELSE EXTENDED.OFF = (A > 2) : _
  228.               GOTO 20175
  229.       CALL ALLCAPS(Z$)
  230.       FILE.NAME.HOLD$ = Z$
  231.       A1$ = Z$
  232.       IF Z$ = DIRECTORY.PREFIX$ THEN _
  233.          GOTO 20164
  234.       IN.FMS = FALSE
  235. 20162 FOR I = 2 TO QX
  236.          A$(I) = B$(I)
  237.       NEXT
  238.       CALL FMS (Z$,SEARCH.STRING$,SEARCH.DATE$,IN.FMS, _
  239.                 CATEGORY.NAME$(),CATEGORY.CODE$(),CATEGORY.DESC$(),_
  240.                 DOWNLOAD.FLAG,CAT.FOUND,LIST.INDEX)
  241.       WHILE DOWNLOAD.FLAG > 0 AND SUBROUTINE.PARAMETER > -1
  242.          B = 1
  243.          GOSUB 20202
  244.          IF FILESYS.PARAMETER > 1 THEN _
  245.             RETURN
  246.         IF DOWNLOAD.COMPLETED and AUTO.END = 1 THEN _
  247.            RETURN
  248.          X$ = CATEGORY.CODE$(CAT.FOUND)
  249.          CALL DISUPDIR (X$,SEARCH.STRING$,SEARCH.DATE$,DOWNLOAD.FLAG,LIST.INDEX)
  250.          CALL CHKTREMAIN (TIME.REMAINING!)
  251.          IF SUBROUTINE.PARAMETER = -1 THEN _
  252.             FILESYS.PARAMETER = 6 : _
  253.             RETURN
  254.          CALL CARRIER
  255.       WEND
  256.       IF SUBROUTINE.PARAMETER = -1 THEN _
  257.          FILESYS.PARAMETER = 7 : _
  258.          RETURN
  259.       FOR I = 2 TO QX
  260.          B$(I) = A$(I)
  261.       NEXT
  262.       ACTIVE.FMS.DIRECTORY$ = ""
  263.       IF IN.FMS THEN _
  264.          GOTO 20175
  265.       IF USER.SECURITY.LEVEL < MIN.SEC.TO.VIEW THEN _
  266.          IF FILE.NAME.HOLD$ = UPLOAD.DIR.CHECK$ THEN _
  267.             FILE.NAME.HOLD$ = "of uploads" : _
  268.             GOTO 20172
  269.       FILE.NAME.HOLD$ = B$(LIST.INDEX)
  270.       IF LIMIT.SEARCH.TO.FMS THEN _
  271.          GOTO 20166
  272.       IF FILE.NAME.HOLD$ = "ALL" OR FILE.NAME.HOLD$ = "A" THEN _
  273.          SEARCHING.ALL = TRUE : _
  274.          DIR.INDEX = LIST.INDEX : _
  275.          GOTO 21890
  276.       CALL BADFILE (FILE.NAME.HOLD$,BAD.FILE.NAME.INDEX)
  277.       ON BAD.FILE.NAME.INDEX GOTO 20163,20172,20176
  278. 20163 FILE.NAME$ = FILE.NAME.HOLD$
  279.       CALL BADNAME (BAD.FILE.NAME.INDEX)
  280.       ON BAD.FILE.NAME.INDEX GOTO 20164,20176
  281. 20164 IF FILE.NAME$ = UPLOAD.DIR.CHECK$ AND _
  282.          USER.SECURITY.LEVEL >= MIN.SEC.TO.VIEW THEN _
  283.             FILE.NAME$ = UPLOAD.PATH$ _
  284.       ELSE FILE.NAME$ = DIRECTORY.PATH$
  285.       FILE.NAME$ = FILE.NAME$ + _
  286.                    FILE.NAME.HOLD$ + _
  287.                    "." + _
  288.                    DIRECTORY.EXTENTION$
  289.       CALL GRAPHIC (USER.GRAPHIC.DEFAULT$)
  290. 20165 IF OK THEN _
  291.          CALL READDIR (1) : _
  292.          IF EC = 0 THEN _
  293.             IF LEFT$(A$,4) = "\FMS" THEN _
  294.                IN.FMS = TRUE : _
  295.                ACTIVE.FMS.DIRECTORY$ = FILE.NAME$ : _
  296.                GOTO 20162 _
  297.             ELSE GOTO 20167
  298. 20166 FILE.NAME$ = DIRECTORY.PATH$ + _
  299.                    FILE.NAME.HOLD$ + ".MNU"
  300.       CALL FINDIT (FILE.NAME$)
  301.       IF OK THEN _
  302.          CALL BUFFILE (FILE.NAME$,LIST.INDEX) : _
  303.          GOTO 20158
  304.       IF ALTDIR.EXTENSION$ = "" THEN _
  305.          GOTO 20172
  306.       FILE.NAME$ = DIRECTORY.PATH$ + _
  307.                    FILE.NAME.HOLD$ + _
  308.                    "." + _
  309.                    ALTDIR.EXTENSION$
  310.       CALL GRAPHIC (USER.GRAPHIC.DEFAULT$)
  311.       IF NOT OK THEN _
  312.          GOTO 20172
  313. 20167 B$(0) = B$(LIST.INDEX)
  314.       IF NOT LIST.NEW THEN _
  315.          GOTO 20168
  316.       GOSUB 20120
  317.       IF FILESYS.PARAMETER > 1 THEN _
  318.          RETURN
  319.       GOTO 20170
  320. 20168 CALL BUFFILE(FILE.NAME$,LIST.INDEX)
  321.       CALL CARRIER
  322.       IF SUBROUTINE.PARAMETER = -1 THEN _
  323.          FILESYS.PARAMETER = 7 : _
  324.          RETURN
  325. 20170 IF LIST.INDEX > 255 THEN _
  326.          LIST.INDEX = 0 : _
  327.          RETURN
  328.       B$(LIST.INDEX) = B$(0)
  329.       GOTO 20175
  330. 20172 IF NOT SEARCHING.ALL THEN _
  331.          A$ = "Directory " + _
  332.               FILE.NAME.HOLD$ + _
  333.               " not found!" : _
  334.          GOSUB 21640 : _
  335.          NO = TRUE : _
  336.          IF FILESYS.PARAMETER > 1 THEN _
  337.             RETURN
  338. 20175 LIST.INDEX = LIST.INDEX + 1
  339.       GOTO 20160
  340. 20176 CALL SVIOLATION
  341.       IF DENY.ACCESS THEN _
  342.          FILESYS.PARAMETER = 4 : _
  343.          RETURN
  344.       GOTO 20172
  345. '
  346. ' *  D - COMMAND FROM FILES MENU (SEARCH FOR FILE TO DOWNLOAD)                *
  347. '
  348. 20180 IF Q > 1 THEN _
  349.          B = 2 : _
  350.          GOTO 20202
  351. 20200 A$ = CX$(5)+"Download"+CX$(6)+" what file(s)"+CX$(7)
  352.       GOSUB 21660
  353.       IF FILESYS.PARAMETER > 1 THEN _
  354.          RETURN
  355.       B = 1
  356.       IF Q = 0 THEN _
  357.          RETURN
  358. 20202 IF (TIME.LOCK AND 2) AND NOT TIME.LOCK.EXEMPT THEN _
  359.          CALL TIMELOCK : _
  360.          IF NOT OK THEN _
  361.             RETURN
  362.       LAST.DOWNLOAD = Q
  363.       FIRST.DOWNLOAD = B
  364.       COMMAND.TRANSFER$ = ""
  365. '      IF AUTODOWNLOAD.AVAILABLE THEN _
  366. '         COMMAND.TRANSFER$ = "X"
  367. '      AUTODOWNLOAD.IN.PROGRESS = AUTODOWNLOAD.AVAILABLE
  368.       IF LAST.DOWNLOAD > FIRST.DOWNLOAD THEN _
  369.          Z$ = B$(LAST.DOWNLOAD) : _
  370.          CALL ALLCAPS(Z$) : _
  371.          IF LEN (Z$) = 1 AND INSTR(DFLTXFER$,Z$) > 0 THEN _
  372.             LAST.DOWNLOAD = LAST.DOWNLOAD - 1 : _
  373.             COMMAND.TRANSFER$ = Z$ : _
  374.             AUTODOWNLOAD.IN.PROGRESS = FALSE : _
  375.             IF MID$(INTERNAL.EQUIV$,INSTR(DFLTXFER$,Z$),1) = "N" THEN _ ' KG110606
  376.                COMMAND.TRANSFER$ = ""                                ' KG110606
  377.       BATCH.BYTES# = 0
  378.       BATCH.BLOCKS# = 0
  379.       CALL KILLWORK (NODE.WORK.FILE$)
  380.       EC = 0
  381.       FOR DWN.INDEX = FIRST.DOWNLOAD TO LAST.DOWNLOAD
  382.          GOSUB 20205
  383.          IF FILESYS.PARAMETER > 1 THEN _
  384.             DWN.INDEX = LAST.DOWNLOAD + 1
  385. 20203 NEXT
  386.       IF FILESYS.PARAMETER > 1 THEN _
  387.          RETURN
  388.       BATCH.TRANSFER = FALSE
  389.       COMMAND.TRANSFER$ = ""
  390.       RETURN
  391. 20205 MARK.TIME = (DWN.INDEX = FIRST.DOWNLOAD OR NOT CONCAT.FILES)
  392.       FILE.NAME$ = B$(DWN.INDEX)
  393.       VIOLATION$ = "Download "
  394.       IF PERSONAL.DOWNLOAD THEN _
  395.          CALL BRKFNAME (FILE.NAME$,DR$,Y$,X$,TRUE) : _
  396.          FILE.NAME.HOLD$ = Y$ + _
  397.                            X$ : _
  398.          GOTO 20235
  399.       FILE.NAME.HOLD$ = FILE.NAME$
  400.       CALL BADFILE (FILE.NAME$,BAD.FILE.NAME.INDEX)
  401.       ON BAD.FILE.NAME.INDEX GOTO 20220,20231,20233
  402. 20220 CALL ROTORSDIR (FILE.NAME$,SUBDIR$(),SUBDIR.COUNT + _
  403.                       ((USER.SECURITY.LEVEL < MIN.SEC.TO.VIEW) OR _
  404.                        NOT CAN.DOWNLOAD.FROM.UP),MARK.TIME)
  405. 20225 IF OK THEN _
  406.          GOTO 20235
  407. 20231 A$ = FILE.NAME.HOLD$+ _
  408.            " not found!"
  409.       CALL UPDTCALR (A$,2)
  410. '      IF AUTODOWNLOAD.IN.PROGRESS THEN _
  411. '         A$ = A$ + _
  412. '              " during AUTODOWNLOAD" : _
  413. '         GOSUB 21640 : _
  414. '         RETURN
  415.       A$ = A$ + _
  416.            " Correct name"+PRESS.ENTER.EXPERT$
  417.       GOSUB 21660
  418.       IF FILESYS.PARAMETER > 1 THEN _
  419.          RETURN
  420.       IF Q=0 THEN _
  421.          RETURN
  422.       B$(DWN.INDEX) = B$(1)
  423.       GOTO 20205
  424. 20233 CALL SVIOLATION
  425.       IF DENY.ACCESS THEN _
  426.          FILESYS.PARAMETER = 4 : _
  427.          RETURN
  428.       GOTO 20231
  429. 20235 CALL BADNAME (BAD.FILE.NAME.INDEX)
  430.       ON BAD.FILE.NAME.INDEX GOTO  20236,20245
  431. 20236 LINE.25$ = "(D) " + _
  432.                  Z$
  433. '     IF AUTODOWNLOAD.IN.PROGRESS THEN _
  434. '        MID$(LINE.25$,2,1) = "A"
  435. '
  436. ' *  TEST FOR DOWNLOAD SECURITY                                               *
  437. '
  438.       CALL OPENWORK (FILESEC.FILE$)
  439.       IF EC = 53 THEN _
  440.          CALL UPDTCALR ("Missing file " + FILESEC.FILE$,2) : _
  441.          GOTO 20247
  442. 20242 IF EOF(2) THEN _
  443.          GOTO 20247
  444.       CALL READPARMS (WORK.ARA$(),3,1)
  445.       IF EC <> 0 THEN _
  446.          EL = 20242 : _
  447.          GOTO 21900
  448. 20243 CALL WILDFILE (WORK.ARA$(1),Z$,OK)
  449.       IF NOT OK THEN _
  450.          GOTO 20242
  451. 20244 IF USER.SECURITY.LEVEL < VAL(WORK.ARA$(2)) THEN _
  452.          GOTO 20245
  453.       FILE.PASSWORD$ = WORK.ARA$(3)
  454.       IF FILE.PASSWORD$ = "" THEN _
  455.          GOTO 20247
  456.       CALL ALLCAPS (FILE.PASSWORD$)
  457.       IF FILE.PASSWORD$ = PASSWORD$ THEN _
  458.          GOTO 20247
  459.       A$ = "Enter PASSWORD to download " + _
  460.            FILE.NAME$
  461.       GOSUB 21660
  462.       IF FILESYS.PARAMETER > 1 THEN _
  463.          RETURN
  464.       IF Q = 0 THEN _
  465.          RETURN
  466.       CALL ALLCAPS (B$(1))
  467.       IF B$(1) = FILE.PASSWORD$ THEN _
  468.          GOTO 20247
  469. 20245 VIOLATION$ = "DownLoad " + _
  470.                    FILE.NAME$
  471. 20246 CALL SVIOLATION
  472.       IF DENY.ACCESS THEN _
  473.          FILESYS.PARAMETER = 4
  474.       RETURN
  475. 20247 DF = 0
  476.       CALL BRKFNAME (FILE.NAME$,DR$,X$,EXTENTION$,FALSE)
  477. '      IF AUTODOWNLOAD.IN.PROGRESS THEN _
  478. '         A$ = "Transferring -- " + _
  479. '              B$(DWN.INDEX) : _
  480. '         GOSUB 21640 : _
  481. '         IF FILESYS.PARAMETER > 1 THEN _
  482. '            RETURN
  483.       IF EXTENTION$ = "" OR RELIABLE.MODE OR _
  484.          COMMAND.TRANSFER$ > "A" OR (USER.TRANSFER.DEFAULT$ > "A" AND _
  485.          INTERNAL.PROTO$ <> "N") THEN _
  486.             GOTO 20248
  487.       IF INSTR(".WRK.FW .ZIP.EXE.COM.OBJ.WKS.LBR",EXTENTION$) OR _
  488.          MID$(EXTENTION$,2,1) = "Q" OR _
  489.          (REQUIRE.NON.ASCII AND EXTENTION$ = "BAS") THEN _
  490.          CALL QTPUT ("Non-ASCII required for " + FILE.NAME.HOLD$,1)
  491.  IF INSTR(".WRK.FW .ZIP",EXTENTION$) THEN _
  492.  CALL QTPUT (CX$(1)+"This is a Compressed file use PKUNZIP to Extract"+CX$(7),1) : _
  493.          DF = TRUE
  494. 20248 A$ = ""
  495.       IF BATCH.TRANSFER THEN _
  496.          IF DWN.INDEX < LAST.DOWNLOAD THEN _
  497.             GOTO 20260
  498.       CALL XFERTYPE (2,TRUE)
  499.       IF FF THEN _
  500.          GOTO 20260
  501.       CALL XFERTYPE (1,TRUE)
  502.       IF SUBROUTINE.PARAMETER = -1 THEN _
  503.          RETURN
  504. 20260 TRANSFER.FUNCTION = 1
  505.       GOSUB 21790
  506.       IF FILESYS.PARAMETER > 1 THEN _
  507.          RETURN
  508. BATCH.TRANSFER = BATCH.PROTO
  509. '      BATCH.TRANSFER = (BATCH.PROTO AND (LAST.DOWNLOAD > FIRST.DOWNLOAD))
  510.       IF BATCH.TRANSFER AND COMMAND.TRANSFER$ = "" THEN _
  511.          COMMAND.TRANSFER$ = FT$
  512.       ON INSTR("AXCYN",INTERNAL.PROTO$) GOTO _
  513.          20340, _              ' ASCII DOWNLOAD
  514.          20290, _              ' XMODEM
  515.          20290, _              ' XMODEM CRC
  516.          20270, _              ' YMODEM
  517.          21700                 ' NONE - CANCEL
  518. '
  519. ' *  EXTERNAL PROTOCOL DOWNLOADS/UPLOADS                           *
  520. '
  521. 20261 IF REQ.8.BIT THEN _
  522.          IF NOT EIGHT.BIT THEN _
  523.             GOSUB 20318 : _
  524.             IF FILESYS.PARAMETER > 1 THEN _                          ' DTM0828
  525.                RETURN _                                              ' DTM0828
  526.             ELSE GOSUB 20992 : _                                     ' DTM0828
  527.                  IF FILESYS.PARAMETER > 1 THEN _
  528.                     RETURN
  529.       IF TRANSFER.FUNCTION = 1 THEN _
  530.          GOSUB 20750 : _
  531.          CLOSE 2 : _                                                 ' DTM0828
  532.          IF FILESYS.PARAMETER > 1 OR NOT OK THEN _
  533.             RETURN                                                   ' DTM0828
  534.       IF BATCH.TRANSFER THEN _
  535.          IF DWN.INDEX < LAST.DOWNLOAD THEN _
  536.             RETURN _
  537.          ELSE BLOCKS.IN.FILE# = BATCH.BLOCKS# : _
  538.               BYTES.IN.FILE# = BATCH.BYTES# : _
  539.               NUM.DNLD.BYTS! = BATCH.BYTES# : _                      ' DTM0828
  540.               GOSUB 20780 : _
  541.               IF FILESYS.PARAMETER > 1 OR NOT OK THEN _
  542.                 RETURN                                               ' DTM0828
  543.  '     IF AUTODOWNLOAD.IN.PROGRESS THEN _
  544.  '        CALL SENDNAME
  545.          IF ABORT THEN _
  546.             DOWNLOAD.COMPLETED = FALSE : _
  547.             GOSUB 21760 : _                                          ' DTM0828
  548.             RETURN
  549.       CALL TRANSFER
  550. 20262 CALL CARRIER
  551.       IF SUBROUTINE.PARAMETER = -1 THEN _
  552.          A$ = FAILURE.STRING$ : _
  553.          GOTO 20264
  554.        IF PRIVATE.DOOR THEN _
  555.          COMMAND.TRANSFER$ = FT$ : _
  556.          CALL XFERTYPE (2,TRUE) : _
  557.          COMMAND.TRANSFER$ = ""
  558.       CALL OPENWORK ("XFER-" + NODE.ID$ + ".DEF")
  559.       IF EC <> 0 THEN _
  560.          GOTO 20267
  561.       CALL READPARMS (WORK.ARA$(), FAILURE.PARM, 1)
  562.       IF EC <> 0 THEN _
  563.          GOTO 20267
  564.       CALL KILLWORK ("XFER-" + NODE.ID$ + ".DEF")
  565. 20264 IF PRIVATE.DOOR THEN _
  566.         PRIVATE.DOOR = FALSE : _
  567.         FILE.NAME$ = WORK.ARA$(1) : _
  568.          CALL BRKFNAME (FILE.NAME$,X$,FILE.NAME.HOLD$,Y$,TRUE) : _
  569.          FILE.NAME.HOLD$ = FILE.NAME.HOLD$ + _
  570.                            Y$ : _
  571.          SIZE.ONLY = TRUE : _
  572.          CALL OPENWORK (FILE.NAME$) : _
  573.          GOSUB 20760 : _
  574.          IF FILESYS.PARAMETER > 1 OR NOT OK THEN _
  575.             RETURN
  576.         ' IF LEFT$(WORK.ARA$(FAILURE.PARM),1) = "L" THEN _            ' JM111004
  577.         '    MID$(WORK.ARA$(FAILURE.PARM),1,1) = FAILURE.STRING$      ' JM111004
  578. 20265 IF TRANSFER.FUNCTION = 2 THEN _
  579.          IF INSTR(WORK.ARA$(FAILURE.PARM),FAILURE.STRING$) <> 1 THEN _
  580.             GOTO 20700 _
  581.          ELSE GOTO 20730
  582.       IF TRANSFER.FUNCTION = 1 THEN _
  583.          DOWNLOAD.COMPLETED = (INSTR(WORK.ARA$(FAILURE.PARM),FAILURE.STRING$) <> 1)
  584.       GOSUB 21760
  585.       CALL CARRIER                                                   ' JM111003
  586.       IF SUBROUTINE.PARAMETER = -1 THEN _                            ' JM111003
  587.          FILESYS.PARAMETER = 7                                       ' JM111003
  588.       RETURN
  589. '
  590. ' *  XFER FILE NOT FOUND                                                      *
  591. '
  592. 20267 EL = 20262
  593.       GOTO 21900
  594.  
  595. '
  596. ' *  YMODEM DOWNLOAD DRIVER                                                   *
  597. '
  598. 20270 GOTO 20292
  599. '
  600. ' *  XMODEM DOWNLOAD DRIVER                                                   *
  601. '
  602. 20290 '
  603. 20292 GOSUB 20750
  604.       IF FILESYS.PARAMETER > 1 OR NOT OK THEN _
  605.          RETURN
  606.       A1$ = "SEND"
  607.       GOSUB 20320
  608.       IF FILESYS.PARAMETER > 1 THEN _
  609.          RETURN
  610.       IF LOCAL.USER THEN _
  611.          CALL QTPUT ("Protocol not available in local mode",1) : _
  612.          RETURN
  613. '      IF AUTODOWNLOAD.IN.PROGRESS THEN _
  614. '         GOSUB 20294 : _
  615.          IF ABORT THEN _
  616.             RETURN
  617.       GOSUB 21300
  618.       IF FILESYS.PARAMETER > 1 THEN _
  619.          RETURN
  620.       A$ = ""
  621.       GOTO 20390
  622. 20294 CALL SENDNAME
  623.       RETURN
  624. 20318 A$ = "Please SWITCH to N,8,1 for binary transfer"
  625.       GOSUB 21630
  626.       IF FILESYS.PARAMETER > 1 THEN _
  627.          RETURN
  628.       CALL DELAYIT (3)
  629.       RETURN
  630. 20320 IF NOT EIGHT.BIT THEN _
  631.          GOSUB 20318 : _
  632.          IF FILESYS.PARAMETER > 1 THEN _
  633.             RETURN
  634. 20325 IF CHECKSUM THEN _
  635.          NEGATIVE.ACKNOWLEDGE$ = CHR$(21) : _
  636.          SOL = 132 _
  637.       ELSE NEGATIVE.ACKNOWLEDGE$ = "C" : _
  638.            SOL = 133
  639. 20330 'IF AUTODOWNLOAD.IN.PROGRESS THEN _
  640.       '   RETURN
  641.       A$ = CX$(6)+PROTO.PROMPT$ + CX$(2)+_
  642.             " " + CX$(5)+A1$ +CX$(6)+ _
  643.             " of " +CX$(3)+ _
  644.             FILE.NAME.HOLD$ + CX$(4)+_
  645.             " ready."+CX$(3)+"  <Ctrl X> aborts"+CX$(7)
  646.       GOSUB 21650
  647.       RETURN
  648. '
  649. ' *  ASCII DOWNLOAD DRIVER                                                    *
  650. '
  651. 20340 IF DF THEN _
  652.          A$ = "Switch to a non-ascii protocol" : _
  653.          GOSUB 21650 : _
  654.          RETURN
  655.       GOSUB 20750
  656.       IF FILESYS.PARAMETER > 1 OR NOT OK THEN _
  657.          RETURN
  658.       CALL OPENWORK (FILE.NAME$)
  659.       IF (DWN.INDEX = FIRST.DOWNLOAD OR NOT CONCAT.FILES) THEN _
  660.          A$ = "^X aborts.  ^S suspends ^Q resumes" : _
  661.          GOSUB 21640 : _
  662.          IF FILESYS.PARAMETER > 1 THEN _
  663.             RETURN _
  664.          ELSE A$ = CX$(5)+PROTO.PROMPT$ +CX$(6)+ " SEND of " +CX$(3)+ _
  665.               FILE.NAME.HOLD$ +CX$(2)+ _
  666.               " ready."+CX$(1)+" Press Any Key to start"+CX$(7) : _
  667.          TURBO.KEY = 2 : _
  668.          GOSUB 21660 : _
  669.          IF FILESYS.PARAMETER > 1 THEN _
  670.             RETURN
  671. 20380 STOP.INTERRUPTS = FALSE
  672.       TU = 0
  673.       SWAP TU,PAGE.LENGTH
  674.       CALL BUFFILE (FILE.NAME$,X)
  675.       SWAP TU,PAGE.LENGTH
  676.       NON.STOP = (PAGE.LENGTH < 1)
  677.       IF STOP.FILE THEN _
  678.          DOWNLOAD.COMPLETED = FALSE : _
  679.          GOTO 20390
  680. 20381 IF (DWN.INDEX = LAST.DOWNLOAD OR NOT CONCAT.FILES) THEN _
  681.          CALL QTPUT (CHR$(26),0) : _
  682.          IF NOT LOCAL.USER AND SUBROUTINE.PARAMETER = 0 THEN _
  683.             FOR X = 1 TO 5 : _
  684.                CALL PUTCOM (CHR$(7)) : _
  685.                CALL DELAYIT (3) : _
  686.             NEXT
  687. 20385 DOWNLOAD.COMPLETED = TRUE
  688. 20390 GOTO 21760
  689. '
  690. ' *  U - COMMAND FROM FILES MENU (UPLOAD)                                     *
  691. '
  692. 20395 GOSUB 21640
  693.       IF FILESYS.PARAMETER > 1 THEN _
  694.          RETURN
  695.       A$ = "Correct name of file to upload" + _
  696.            PRESS.ENTER.EXPERT$
  697.       GOSUB 21660
  698.       IF FILESYS.PARAMETER > 1 THEN _
  699.          RETURN
  700.       IF Q = 0 THEN _
  701.          RETURN
  702.       B$(ANS.INDEX) = B$(1)
  703.       GOTO 20435
  704. 20400 CALL TIMEREMAIN (TIME.REMAINING!)
  705.       Q! = TCA!
  706.       FIRST.UPLOAD = 1
  707.       IF Q > 1 THEN _
  708.          FIRST.UPLOAD = 2 : _
  709.          GOTO 20430
  710.       GOSUB 20420
  711.       GOTO 20430
  712. 20420 A$ = "Upload what file(s)"
  713.       GOSUB 21660
  714.       IF FILESYS.PARAMETER > 1 THEN _
  715.          RETURN
  716.       IF Q = 0 THEN _
  717.          RETURN
  718.       RETURN
  719. '
  720. ' *  SEARCH FOR DUPLICATE FILENAME                                            *
  721. '
  722. 20430 LAST.UPLOAD = Q
  723.       Z$ = B$(LAST.UPLOAD)
  724.       IF LEN(Z$) = 1 THEN _
  725.          CALL ALLCAPS (Z$) : _
  726.          IF INSTR(DFLTXFER$,Z$) > 0 THEN _
  727.             LAST.UPLOAD = LAST.UPLOAD - 1 : _
  728.             COMMAND.TRANSFER$ = Z$
  729.       FOR ANS.INDEX = FIRST.UPLOAD TO LAST.UPLOAD
  730.          GOSUB 20435
  731.          IF FILESYS.PARAMETER > 1 THEN _
  732.             ANS.INDEX = LAST.UPLOAD + 1
  733.       NEXT
  734.       COMMAND.TRANSFER$ = ""
  735.       RETURN
  736. 20435 FILE.NAME.HOLD$ = B$(ANS.INDEX)
  737.       CALL ALLCAPS(FILE.NAME.HOLD$)
  738.       FILE.NAME$ = FILE.NAME.HOLD$
  739.       VIOLATION$ = "Upload "
  740.       IF INSTR(FILE.NAME$,":") OR _
  741.          INSTR(FILE.NAME$,"\") OR _
  742.          INSTR(FILE.NAME$," ") OR _       'Pe 03/06/89
  743.          INSTR(FILE.NAME$,"/") THEN _
  744.          GOTO 20451
  745.       CALL BADFILE (FILE.NAME$,BAD.FILE.NAME.INDEX)
  746. 'comment out the NEXT 2 lines if you want to enable files without EXTENSION
  747. 'to regular users
  748. '
  749. IF EXT$ = "" AND USER.SECURITY.LEVEL < OVERWRITE.SECURITY.LEVEL THEN _
  750.        GOTO 20451       'Pe 12/22/88
  751. '
  752.       ON BAD.FILE.NAME.INDEX GOTO 20440,20451,20515
  753. 20440 TMP.FILE.NAME$ ="NOTHANX.DEF"               'PE mode
  754.       CALL FINDIT (TMP.FILE.NAME$)                                'DGS-UNW
  755.       IF OK THEN                                                  'DGS-UNW
  756.        CALL QTPUT ("Checking off line file list....",1)           'Pe 02/11/89
  757.      OPEN TMP.FILE.NAME$ FOR INPUT AS #9                      'DGS-UNW
  758.      HAV.FILE$ = ""                                           'DGS-UNW
  759.      FILE.IN.LIST = FALSE                                     'DGS-UNW
  760.      WHILE NOT EOF(9) AND NOT FILE.IN.LIST                    'DGS-UNW
  761.         INPUT #9, HAV.FILE$                                   'DGS-UNW
  762.         CALL ALLCAPS (HAV.FILE$)                              'DGS-UNW
  763.         FILE.IN.LIST = (INSTR(FILE.NAME.HOLD$,HAV.FILE$) > 0) 'DGS-UNW
  764.      WEND                                                     'DGS-UNW
  765.      CLOSE 9                                                  'DGS-UNW
  766.       END IF                                                      'DGS-UNW
  767.       IF FILE.IN.LIST THEN _                                      'DGS-UNW
  768.       CALL BUFFILE ("NOTHANX.MSG",X) : _         'Pe 02/19/89
  769.      GOTO 20453                                               'DGS-UNW
  770.        CALL ROTORSDIR (FILE.NAME$,SUBDIR$(),SUBDIR.COUNT,TRUE)
  771.        IF OK THEN _
  772.          GOTO 20452
  773.       CLOSE 2                                                        ' MC0220
  774.       OPEN "EXTCHECK.DEF" FOR INPUT AS #2                            ' MC0220
  775.       DO WHILE NOT EOF(2)                                            ' MC0220
  776.        INPUT #2, CHECK$                                          ' MC0220
  777.       IF INSTR(FILE.NAME$,".") AND _                                 ' MC0220
  778.      RIGHT$(FILE.NAME.HOLD$,3) <> CHECK$ THEN _                  ' MC0220
  779.      FILE.NAME$ = LEFT$(FILE.NAME.HOLD$,LEN(FILE.NAME.HOLD$)-3) + _
  780.      CHECK$ : _                                                  ' MC0220
  781.      CALL ROTORSDIR (FILE.NAME$,SUBDIR$(),SUBDIR.COUNT,TRUE)     ' MC0220
  782.       IF OK THEN _                                                   ' MC0220
  783.      GOTO 20452                                                  ' MC0220
  784.        LOOP                                                          ' MC0220
  785.        CLOSE 2                                                       ' MC0220
  786.       GOTO 20475
  787. ' Pe03/06/89  to 20452
  788. 20451 A$ = "Invalid file name. File name cannot contain a Drive letter"+CRLF$ +_
  789.            "Subdirectory name, a Space, or any WildCard Characters "
  790.       GOSUB 21655
  791.       CALL DELAYIT (2)
  792.       FILESYS.PARAMETER = 3
  793.       RETURN
  794.      ' GOTO 20395
  795.  ' old code above
  796. 20452 IF USER.SECURITY.LEVEL < OVERWRITE.SECURITY.LEVEL THEN _
  797.          GOTO 20453
  798.       A$ = "Overwrite file (Y,[N])"
  799.       GOSUB 21660
  800.       IF FILESYS.PARAMETER > 1 THEN _
  801.          RETURN
  802.       IF NOT YES THEN _
  803.          GOTO 20453
  804.       Z$ = FILE.NAME$
  805.       CALL KILLWORK (FILE.NAME$)
  806.       IF EC <> 0 THEN _
  807.          EL = 20452 : _
  808.          GOTO 21900
  809.       GOTO 20475
  810. 20453 CLOSE 2
  811.       IF USER.SECURITY.LEVEL < ADD.DIR.SECURITY THEN _
  812.          CALL QTPUT ("Thanks, but we already have " + FILE.NAME.HOLD$,1) : _
  813.          CALL UPDTCALR ("Upload duplicate " + FILE.NAME.HOLD$,2) : _
  814.          RETURN
  815.       A$ = "Add new directory entry (Y,[N])"
  816.       TURBO.KEY = - TURBO.KEY.USER
  817.       GOSUB 21660
  818.       IF FILESYS.PARAMETER > 1 THEN _
  819.          RETURN
  820.       IF NOT YES THEN _
  821.          RETURN
  822.       ADDING.DESC.ONLY = TRUE
  823. CALL UPDTUPLOAD (CATEGORY.NAME$(),CATEGORY.CODE$(),LINES.IN.MESSAGE,1) 'UPL-MOD
  824.       GOSUB 20702
  825.       RETURN
  826. 20475 FILE.NAME$ = LEFT$(FILE.NAME$,LEN(FILE.NAME$)-3) + _           'MC0220
  827.       RIGHT$(FILE.NAME.HOLD$,3)                                      'MC0220
  828.       Z$ = UPLOAD.DRIVE.FILE$
  829.       CALL FINDFREE
  830.       IF VAL(FREE.SPACE$) < 4096 THEN _
  831.          CALL QTPUT ("No room for uploads.  Try tomorrow.",1) : _
  832.          ANS.INDEX = LAST.UPLOAD + 1 : _
  833.          RETURN
  834.       A$ = "Upload disk has" + _
  835.            FREE.SPACE$
  836.       GOSUB 21640
  837.       IF FILESYS.PARAMETER > 1 THEN _
  838.          RETURN
  839. '*****************
  840. CALL UPDTUPLOAD (CATEGORY.NAME$(),CATEGORY.CODE$(),LINES.IN.MESSAGE,1)  '<++++++
  841. '*****************
  842. IF ABORT THEN _     'PE 12/14/88
  843. ABORT = FALSE : _   'PE 12/14/88
  844.  RETURN
  845.       LINE.25$ = "(U) " + _
  846.                  FILE.NAME.HOLD$
  847.       SUBROUTINE.PARAMETER = 2
  848.       CALL LINE25
  849.       A$ = ""
  850.       OK = TRUE
  851. 20477 CALL XFERTYPE (2,TRUE)
  852.       IF FF THEN _
  853.          GOTO 20500
  854.       CALL XFERTYPE (1,TRUE)
  855.       IF SUBROUTINE.PARAMETER = -1 THEN _
  856.          RETURN
  857. 20500 CALL AUTOLOGOFF           'Pe 04/09/89
  858.       TRANSFER.FUNCTION = 2
  859.       AUTODOWNLOAD.IN.PROGRESS = FALSE
  860.       GOSUB 21790
  861.       IF FILESYS.PARAMETER > 1 THEN _
  862.          RETURN
  863.       ON INSTR("AXCYN",INTERNAL.PROTO$) GOTO _
  864.          20560, _         ' ASCII UPLOAD
  865.          20542, _         ' XMODEM
  866.          20542, _         ' XMODEM CRC
  867.          20542, _         ' YMODEM
  868.          20735            ' NONE - CANCEL
  869.       GOTO 20261
  870. 20510 D$ = "<Esc> by SYSOP aborts"
  871.       GOSUB 21710
  872.       RETURN
  873. 20515 CALL SVIOLATION
  874.       IF DENY.ACCESS THEN _
  875.          FILESYS.PARAMETER = 4 : _
  876.          RETURN
  877.       GOTO 20420
  878. '
  879. ' *  XMODEM/YMODEM UPLOAD DRIVER
  880. '
  881. 20542 A1$ = "RECEIVE"
  882.       GOSUB 20320
  883.       IF FILESYS.PARAMETER > 1 THEN _
  884.          RETURN
  885.       OK = TRUE
  886.       GOSUB 20860
  887.       IF FILESYS.PARAMETER > 1 THEN _
  888.          RETURN
  889.       IF OK THEN _
  890.          GOTO 20700
  891.       GOTO 20730
  892. '
  893. ' *  ASCII UPLOAD                                                             *
  894. '
  895. 20560 LINE.ACK = (DEFAULT.LINE.ACK$ <> "")
  896.       IF LINE.ACK THEN _
  897.          A$ = "Acknowledge each line ([Y],N)" : _
  898.          TURBO.KEY = - TURBO.KEY.USER : _
  899.          GOSUB 21660 : _
  900.          LINE.ACK = NOT NO : _
  901.          IF FILESYS.PARAMETER > 1 THEN _
  902.             RETURN
  903.       CALL QTPUT("Transfer MUST end with a <Ctrl-K>",1)
  904.       CALL QTPUT(PROTO.PROMPT$+" RECEIVE of " + FILE.NAME.HOLD$ + " ready",1)
  905.       OK = FALSE
  906.       XOFF = FALSE
  907.       CALL OPENOUTW(FILE.NAME$)
  908.       IF EC <> 0 AND EC <> 53 THEN _
  909.          EL = 20560 : _
  910.          GOTO 21900
  911.       GOSUB 20510
  912.       IF FILESYS.PARAMETER > 1 THEN _
  913.          RETURN
  914. 20600 CALL EOFCOMM (CHAR%)
  915.       WHILE CHAR% <> -1
  916.          CALL CARRIER
  917.          IF SUBROUTINE.PARAMETER = -1 THEN _
  918.             FILESYS.PARAMETER = 7 : _
  919.             RETURN
  920.          IF NOT FOSSIL THEN _
  921.             IF LOF(3) < 512 THEN _
  922.                CALL PUTCOM(XOFF$) : _
  923.                XOFF = TRUE
  924. 20610    CALL FLUSHCOM (X$)
  925.          IF SUBROUTINE.PARAMETER = -1 THEN _
  926.             RETURN
  927.          IF INSTR(X$,CHR$(11)) THEN _
  928.             GOTO 20650
  929.          OK = TRUE
  930. 20620    CALL PRINTWRK (X$)
  931.          IF LINE.ACK THEN _
  932.             IF INSTR(X$,CHR$(10)) > 0 THEN _
  933.                CALL PUTCOM (DEFAULT.LINE.ACK$)
  934.          IF EC <> 0 THEN _
  935.             EL = 20620 : _
  936.             GOTO 21900
  937.          D$ = X$
  938.          NUM.RETURNS = 0
  939.          GOSUB 21720
  940.          IF FILESYS.PARAMETER > 1 THEN _
  941.             RETURN
  942. 20621    CALL FINDFUNC
  943.          IF SUBROUTINE.PARAMETER < 0 THEN _
  944.             FILESYS.PARAMETER = 2 : _
  945.             RETURN
  946.          IF KEY.PRESSED$ = ESCAPE$ THEN _
  947.             GOTO 20745
  948.          IF NOT OK THEN _
  949.             GOTO 20670
  950.       CALL EOFCOMM (CHAR%)
  951. 20630 WEND
  952.       CALL CARRIER
  953.       IF SUBROUTINE.PARAMETER = -1 THEN _
  954.          FILESYS.PARAMETER = 7 : _
  955.          RETURN
  956.       IF XOFF THEN _
  957.          XOFF = FALSE : _
  958.          CALL PUTCOM (XON$) : _
  959.          IF EC <> 0 THEN _
  960.             EL = 20630 : _
  961.             GOTO 21900
  962.       GOTO 20600
  963. 20650 X = INSTR(X$,CHR$(11))
  964.       IF X = 1 THEN _
  965.          IF NOT OK THEN _
  966.             GOTO 20730 _
  967.          ELSE GOTO 20700
  968.       CALL PRNTWRKA (LEFT$(X$,X-1))
  969.       IF EC <> 0 THEN _
  970.          EL = 20650 : _
  971.          GOTO 21900
  972.       GOTO 20700
  973. 20670 A$ = XOFF$ + _
  974.            "System error! Upload aborted <Ctrl-K> continues"
  975. 20675 GOSUB 21650
  976.       IF FILESYS.PARAMETER > 1 THEN _
  977.          RETURN
  978.       CALL DELAYIT (3)
  979.       CALL PUTCOM(XON$)
  980. 20680 CALL EOFCOMM (CHAR%)
  981.       WHILE CHAR% <> -1
  982.          CALL FLUSHCOM(X$)
  983.          IF INSTR(X$,CHR$(11)) THEN _
  984.             GOTO 20730
  985. 20685    CALL CARRIER
  986.          IF SUBROUTINE.PARAMETER = -1 THEN _
  987.             FILESYS.PARAMETER = 7 : _
  988.             RETURN
  989.       CALL EOFCOMM (CHAR%)
  990.       WEND
  991.       GOTO 20680
  992. '
  993. ' *  UPDATE UPLOAD DIRECTORY                                                  *
  994. '
  995. 20700 GOSUB 21780
  996.       IF FILESYS.PARAMETER > 1 THEN _
  997.          RETURN
  998. 20702 CALL UPDTUPLOAD (CATEGORY.NAME$(),CATEGORY.CODE$(),LINES.IN.MESSAGE,2)  '<++++++
  999. '***** AUTO UP MOD *****
  1000.  IF AUTO.END = 1 THEN _                   'AUTO-UP MOD to next comment
  1001. CALL BRKFNAME (FILE.NAME$,DR$,X$,EXTENTION$,TRUE): _
  1002. Z$ = X$+EXTENTION$+DF$+" at "+TIM$ +" using " + FT$ + STR$(BYTES.IN.FILE#) :_
  1003.       CALL UPDTCALR (Z$,2) : _
  1004.      RETURN                             'AUTO-UP MOD
  1005. '***** end of Auto Up Mod****
  1006.       IF NOT GET.EXT.DESC THEN _
  1007.          GOTO 20710
  1008.       FT$ = "Extended Description for " + FILE.NAME.HOLD$
  1009.       SYSOP.COMMENT = TRUE
  1010.       MAX.MESSAGE.LINES = MAX.EXTENDED.LINES
  1011.       LL = RIGHT.MARGIN
  1012.       RIGHT.MARGIN = 30 + MAX.DESC.LEN
  1013.       FILESYS.PARAMETER = 5
  1014.       RETURN
  1015. 20705 MAX.MESSAGE.LINES = MAX.MESSAGE.LINES.DEF
  1016.       RIGHT.MARGIN = LL
  1017.  CALL UPDTUPLOAD (CATEGORY.NAME$(),CATEGORY.CODE$(),LINES.IN.MESSAGE,3)  '<++++++
  1018. 20710 IF ADDING.DESC.ONLY THEN _
  1019.          ADDING.DESC.ONLY = FALSE : _
  1020.          RETURN
  1021.       IF BYTES.IN.FILE# > 0.0 THEN _
  1022.          GOTO 21770
  1023. 20730 GOSUB 21780
  1024.       CALL QTPUT ("Upload aborted",1)
  1025. 20735 CALL KILLWORK (FILE.NAME$)
  1026.       IF EC <>0 THEN _
  1027.          EL = 20736 : _
  1028.          GOTO 21900
  1029.       RETURN
  1030. '
  1031. ' *  SYSOP ABORTED UPLOAD                                                     *
  1032. '
  1033. 20745 A$ = XOFF$ + _
  1034.            "SYSOP aborted upload. Stop tranfer. <Ctrl-K> continues"
  1035.       GOTO 20675
  1036. '
  1037. ' *  CALCULATE DOWNLOAD TIME ESTIMATE                                         *
  1038. '
  1039. 20750 START.OF.HEADER$ = CHR$(1 - (INTERNAL.PROTO$ = "Y"))
  1040.       CALL OPENRSEQ (FILE.NAME$,MAX.BLOCK,DF,FLEN)
  1041. 20760  IF EC <> 0 THEN _                                              ' KG101405
  1042.          CALL QTPUT ("Unable to access "+FILE.NAME.HOLD$,1) : _      ' KG101405
  1043.          CALL UPDTCALR ("Unable to access "+FILE.NAME$,2) : _        ' KG101405
  1044.          OK = FALSE : _                                              ' KG101405
  1045.          EC = 0 : _                                                  ' KG101405
  1046.          BYTES.IN.FILE# = 0 : _                                      ' KG101405
  1047.          RETURN                                                      ' KG101405
  1048.       BYTES.IN.FILE# = LOF(2)
  1049.       NUM.DNLD.BYTS! = LOF(2)
  1050.       OK = TRUE
  1051.       IF SIZE.ONLY THEN _
  1052.          SIZE.ONLY = FALSE : _
  1053.          RETURN
  1054.       BLOCKS.IN.FILE# = MAX.BLOCK
  1055.       IF BATCH.TRANSFER THEN _
  1056.          BATCH.BYTES# = BATCH.BYTES# + BYTES.IN.FILE# : _
  1057.          BATCH.BLOCKS# = BATCH.BLOCKS# + BLOCKS.IN.FILE# : _
  1058.          CALL OPENWRKA (NODE.WORK.FILE$) : _
  1059.          CALL PRNTWRKA (FILE.NAME$) : _
  1060.          RETURN
  1061.      20780 A$ = CX$(1)+"File Size    :"
  1062.       OK = TRUE
  1063.       IF BLOCK.SIZE > 0 THEN _
  1064.          A$ = A$ +CX$(2)+ _
  1065.               STR$(FIX(BLOCKS.IN.FILE#)) +CX$(3)+ _
  1066.               " blocks "+CX$(7)
  1067. 20785 BLOCKS.IN.FILE# = BLOCKS.IN.FILE# / _
  1068.                         VAL(MID$("0000030004501200240048009601920", -4 * BPS, 4))
  1069.       BLOCKS.IN.FILE# = BLOCKS.IN.FILE# * FLEN / SPEED.FACTOR!
  1070.       IF (DWN.INDEX > 1 AND CONCAT.FILES) THEN _
  1071.          RETURN
  1072.       A$ = A$ + _
  1073.         CX$(2)+ STR$(BYTES.IN.FILE#) + _
  1074.          CX$(3)+  " bytes"+CX$(7)
  1075.       GOSUB 21650
  1076.       IF FILESYS.PARAMETER > 1 THEN _
  1077.          RETURN
  1078.       IF BYTES.IN.FILE# < 1 THEN _
  1079.          RETURN
  1080. 20790 SUBROUTINE.PARAMETER = 2
  1081.       CALL LINE25
  1082.       A$ = "Transfer Time:" + _
  1083.          STR$(INT(BLOCKS.IN.FILE# / 60)) + _
  1084.          " min," + _
  1085.          STR$(INT(BLOCKS.IN.FILE# - (INT(BLOCKS.IN.FILE# / 60) * 60))) + _
  1086.          " sec (approx)"
  1087.       GOSUB 21650
  1088.       IF FILESYS.PARAMETER > 1 THEN _
  1089.          RETURN
  1090. 20791 IF PERSONAL.DOWNLOAD THEN _
  1091.          RETURN
  1092.       CALL CHKTREMAIN (TIME.REMAINING!)
  1093.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1094.          FILESYS.PARAMETER = 6 : _
  1095.          RETURN
  1096.       OK = TRUE
  1097.       IF (INT(BLOCKS.IN.FILE# / 60) + 1) > INT(TIME.REMAINING!) THEN _
  1098.          A$ = "Not enough time left!" : _
  1099.          CALL UPDTCALR (FILE.NAME$ + " " + A$,2) : _
  1100.          CALL QTPUT (A$,1): _
  1101.          A$ = "" : _
  1102.          OK = FALSE : _
  1103.          RETURN
  1104.                 NOTIFY$ =  WELCOME.FILE.DRV.PATH$ + _
  1105.                      "TELTHEM.DEF"
  1106.         STOP.INTERRUPTS = TRUE                             'Pe 06/12/89
  1107.        CALL BUFFILE (NOTIFY$,X)                    'Pe 06/12/89
  1108.       CALL AUTOLOGOFF
  1109.       CALL CHECKRATIO (TRUE)
  1110.       RETURN
  1111. 20810 CALL SETABORT (DELAY!,6)
  1112. 20840 CALL EOFCOMM (CHAR%)
  1113.       IF CHAR% = -1 THEN _
  1114.          GOTO 20850
  1115.       CALL FLUSHCOM(Y$)
  1116.       RETURN
  1117. 20850 CALL CHECKTIM (DELAY!)
  1118.       ON SUBROUTINE.PARAMETER GOTO 20840,20851
  1119. 20851 Y$ = ""
  1120.       CALL CARRIER
  1121.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1122.          FILESYS.PARAMETER = 7 : _
  1123.          RETURN
  1124.       RETURN
  1125. '
  1126. ' *  XMODEM/YMODEM UPLOAD                                                     *
  1127. '
  1128. 20860 GOSUB 20992
  1129.       IF FILESYS.PARAMETER > 1 THEN _
  1130.          RETURN
  1131.       IF NOT EIGHT.BIT THEN _
  1132.          GOSUB 21280 : _
  1133.          IF FILESYS.PARAMETER > 1 THEN _
  1134.             RETURN
  1135. 20900 X$ = ""
  1136.       SEC = 1
  1137.       'CALL OPENOUTW (FILE.NAME$)
  1138.       IF FLEN > WRITE.BUF.DEF THEN _
  1139.          WRITE.BUF = FLEN _
  1140.       ELSE WRITE.BUF = WRITE.BUF.DEF
  1141.       CALL OPENRSEQ (FILE.NAME$,Y,DF,WRITE.BUF)
  1142.       IF EC <> 0 AND EC <> 53 THEN _
  1143.          EL = 20900 : _
  1144.          GOTO 21900
  1145.       FIELD #2, WRITE.BUF AS UPLOAD.RECORD$
  1146.       RECS.WRIT = 0
  1147.       NUM.IN.BUFF = 0
  1148.       CALL SETABORT (TRANSFER.ABORT!,WAIT.BEFORE.DISCONNECT)
  1149.       YY$ = " " + _
  1150.             CHR$(1) + _
  1151.             CHR$(2) + _
  1152.             END.TRANSMISSION$ + _
  1153.             CANCEL$
  1154. 20903 CALL PUTCOM (NEGATIVE.ACKNOWLEDGE$)
  1155. 20920 X = 1
  1156. 20922 CALL CARRIER
  1157.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1158.          FILESYS.PARAMETER = 7 : _
  1159.          RETURN
  1160.       CALL FINDFUNC
  1161.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1162.          GOSUB 20510 :_
  1163.          IF FILESYS.PARAMETER > 1 THEN _
  1164.             RETURN _
  1165.          ELSE GOTO 21240
  1166.       GOSUB 20810
  1167.       IF FILESYS.PARAMETER > 1 THEN _
  1168.          RETURN
  1169. 20930 J = INSTR(YY$,LEFT$(Y$,1))
  1170.       ON J GOTO 20960,20999,20999,21220,21230
  1171. 20960 IF Y$ <> "" THEN _
  1172.          GOSUB 21280 : _
  1173.          IF FILESYS.PARAMETER > 1 THEN _
  1174.             RETURN _
  1175.          ELSE CALL CHECKTIM (TRANSFER.ABORT!) : _
  1176.          ON SUBROUTINE.PARAMETER GOTO 20920,21230
  1177. 20970 X = X + 1
  1178.       CALL DELAYIT (1)
  1179.       CALL PUTCOM (NEGATIVE.ACKNOWLEDGE$)
  1180.       IF X < 6 THEN _
  1181.          GOTO 20922
  1182.       D$ = "Upload Timeout"
  1183.       GOSUB 21710
  1184.       IF FILESYS.PARAMETER > 1 THEN _
  1185.          RETURN
  1186.       CALL CHECKTIM (TRANSFER.ABORT!)
  1187.       ON SUBROUTINE.PARAMETER GOTO 20990,21230
  1188. 20990 GOTO 20920
  1189. '
  1190. ' *  CHANGE TO 8 BIT FOR XMODEM                                               *
  1191. '
  1192. 20992 GOSUB 20510
  1193.       IF FILESYS.PARAMETER > 1 THEN _
  1194.          FILESYS.PARAMETER = 2 : _
  1195.          RETURN
  1196.       IF NOT EIGHT.BIT THEN _
  1197.          PREV.LINE.CONTROL = INP (LINE.CONTROL.REGISTER) : _
  1198.          CALL DELAYIT (3) : _
  1199.          SWITCHED.TO.EIGHT = TRUE : _
  1200.          OUT LINE.CONTROL.REGISTER,3
  1201. 20996 SO = 0
  1202.       RETURN
  1203. '
  1204. ' *  EXPECTED BLOCK LENGTH. 132 FOR CHECKSUM, 133 FOR CRC, 1029 FOR YMODEM    *
  1205. '
  1206. 20999 SOL = 896 * J - 1659 + CHECKSUM
  1207.       DATA.SOL = 128 - (SOL > 1024)*896
  1208.       GOTO 21020
  1209. '
  1210. ' *  XMODEM/YMODEM UPLOAD                                                     *
  1211. '
  1212. 21000 GOSUB 20810
  1213.       IF FILESYS.PARAMETER > 1 THEN _
  1214.          RETURN
  1215.       IF Y$ = "" THEN _
  1216.          D$ = "Upload Timeout" : _
  1217.          GOSUB 21710 : _
  1218.          IF FILESYS.PARAMETER > 1 THEN _
  1219.             RETURN _
  1220.          ELSE GOTO 21040
  1221. 21020 X$ = X$ + _
  1222.            Y$
  1223.       IF LEN(X$) < SOL THEN _
  1224.          GOTO 21000
  1225. 21040 IF LEN(X$) = SOL THEN _
  1226.          GOTO 21090
  1227. 21050 IF LEN(X$) > SOL THEN _
  1228.          GOTO 21180
  1229. 21060 IF X$ = END.TRANSMISSION$ THEN _
  1230.          GOTO 21220
  1231. 21070 IF X$ = CANCEL$ THEN _
  1232.          GOTO 21230
  1233. 21080 GOTO 21170
  1234. 21090 JX = ASC(MID$(X$,2,1))
  1235.       IF SEC = JX THEN _
  1236.          GOTO 21100
  1237.       IF SEC > JX THEN _
  1238.          CALL PUTCOM (RIGHT$(ACKC$,1 - (JX = 0))) : _                ' KG120304
  1239.          GOTO 21150
  1240.       GOTO 21200
  1241. 21100 IF (SEC XOR 255) <> ASC(MID$(X$,3,1)) THEN _
  1242.          GOTO 21210
  1243. 21110 IF CHECKSUM THEN _
  1244.          WK$ = MID$(X$,4,128) : _
  1245.          GOSUB 21750 : _
  1246.          IF FILESYS.PARAMETER > 1 THEN _
  1247.             RETURN _
  1248.          ELSE IF XMODEM.CHECKSUM <> ASC(MID$(X$,132,1)) THEN _
  1249.             GOTO 21190 _
  1250.          ELSE GOTO 21120
  1251.       WK$ = MID$(X$,4)
  1252.       GOSUB 21750
  1253.       IF FILESYS.PARAMETER > 1 THEN _
  1254.          RETURN
  1255. 21113 IF CRC.VALUE <> 0 THEN _
  1256.          GOTO 21191
  1257. 21120 SO = SO + 1
  1258.       CALL PUTCOM (ACKNOWLEDGE$)
  1259. 21131 IF NUM.IN.BUFF >= WRITE.BUF THEN _
  1260.          NUM.IN.BUFF = 0 : _
  1261.          CALL PUTWORK (UPLOAD.RECORD$,RECS.WRIT,WRITE.BUF) : _
  1262.          IF EC <> 0 THEN _
  1263.             EL = 21131 : _
  1264.             GOTO 21900
  1265.       MID$(UPLOAD.RECORD$,NUM.IN.BUFF+1,DATA.SOL) = WK$
  1266.       NUM.IN.BUFF = NUM.IN.BUFF + DATA.SOL
  1267. 21145 SEC = 255 AND (SEC + 1)
  1268.       CALL QLPRNT ("OK Rec Blk #",SO)
  1269. 21150 X$ = ""
  1270.       XMODEM.CHECKSUM = 0
  1271.       CALL SETABORT(TRANSFER.ABORT!,45)
  1272.       GOTO 20920
  1273. 21170 A$ = "Short Blk #"
  1274.       GOTO 21212
  1275. 21180 A$ = "Long Blk #"
  1276.       GOTO 21212
  1277. 21190 A$ = "Chksum Error #"
  1278.       GOTO 21212
  1279. 21191 A$ = "CRC Error"
  1280.       GOTO 21212
  1281. 21200 A$ = "Blk # Error in #"
  1282.       JX = ASC(MID$(X$,2,1))
  1283.       IF SEC < JX THEN _
  1284.          GOTO 21212
  1285.       CALL PUTCOM (ACKNOWLEDGE$) ' RIGHT$(ACKC$,1 - (JX = 0)))
  1286.       GOTO 21150
  1287. 21210 A$ = "Complement Error in #"
  1288. 21212 GOSUB 21280
  1289.       IF FILESYS.PARAMETER > 1 THEN _
  1290.          RETURN
  1291.       CALL PUTCOM (NEGATIVE.ACKNOWLEDGE$)
  1292.       CALL LPRNT(LINE.FEED$ + A$ + STR$(SO + 1),0)
  1293.       GOTO 21150
  1294. 21220 IF NUM.IN.BUFF < 1 THEN _
  1295.          GOTO 21225
  1296.       WK$ = LEFT$(UPLOAD.RECORD$,NUM.IN.BUFF)
  1297.       CALL OPENRSEQ (FILE.NAME$,MAX.BLOCK,DF,128)
  1298.       FIELD #2, 128 AS UPLOAD.RECORD$
  1299.       MAX.BLOCK = CDBL(RECS.WRIT) * WRITE.BUF / 128
  1300.       FOR I = 1 TO NUM.IN.BUFF/128
  1301.          CALL PUTWORK (MID$(WK$,128*I-127,128),MAX.BLOCK,128)
  1302.          IF EC > 0 THEN _
  1303.             EL = 21220 : _
  1304.             GOTO 21900
  1305.       NEXT
  1306.       CLOSE 2
  1307. 21225 CALL PUTCOM (ACKNOWLEDGE$)
  1308.       GOTO 21250
  1309. 21230 D$ = LINE.FEED$ + _
  1310.            "Transfer Aborted"
  1311.       GOSUB 21710
  1312.       IF FILESYS.PARAMETER > 1 THEN _
  1313.          RETURN
  1314. 21240 CALL EOFCOMM (CHAR%)
  1315.       IF CHAR% <> -1 THEN _
  1316.          GOSUB 21280 : _
  1317.          IF FILESYS.PARAMETER > 1 THEN _
  1318.             RETURN _
  1319.          ELSE CALL DELAYIT (1) : _
  1320.          GOTO 21240
  1321.       CALL PUTCOM (CANCEL$ + CANCEL$)
  1322.       CALL DELAYIT (1)
  1323.       CALL EOFCOMM (CHAR%)
  1324.       IF CHAR% <> -1 THEN _
  1325.          GOTO 21240
  1326.       OK = FALSE
  1327. 21250 EIGHT.BIT = TRUE
  1328.       RETURN
  1329. '
  1330. ' *  CLEAR GARBAGE OUT OF COMMUNICATIONS BUFFER                               *
  1331. '
  1332. 21280 CALL CARRIER
  1333.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1334.          FILESYS.PARAMETER = 7 : _
  1335.          RETURN
  1336.       CALL EOFCOMM (CHAR%)
  1337.       IF CHAR% = -1 THEN _
  1338.          RETURN
  1339. 21281 CALL FLUSHCOM(DF$)
  1340.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1341.          RETURN
  1342.       GOTO 21280
  1343. '
  1344. ' *  XMODEM/YMODEM DOWNLOAD
  1345. '
  1346. 21300 GOSUB 20992
  1347.       IF FILESYS.PARAMETER > 1 THEN _
  1348.          RETURN
  1349.       SEC = 0
  1350.       GOSUB 21280
  1351.       IF FILESYS.PARAMETER > 1 THEN _
  1352.          RETURN
  1353.       NEGATIVE.ACKNOWLEDGE$ = CHR$(21)
  1354.       CALL SETABORT (TRANSFER.ABORT!,WAIT.BEFORE.DISCONNECT)
  1355. 21303 FIELD 2,FLEN AS DOWNLOAD.RECORD$
  1356. '
  1357. ' *  ROUTINE TO START AN "XMODEM" OR "YMODEM" DOWNLOAD.  CHECK'S INITIAL      *
  1358. ' *  "HANDSHAKE" TO SEE IF CHARACTER IS SENT IS A:                            *
  1359. ' *           "X" = XMODEM WITH CHECKSUM AND 128 CHARACTER RECORDS            *
  1360. ' *           "C" = XMODEM WITH CRC CHECK AND 128 CHARACTER RECORDS           *
  1361. ' *           "Y" = YMODEM WITH CRC CHECK AND 1024 CHARACTER RECORDS          *
  1362. '
  1363. 21350 CALL EOFCOMM (CHAR%)
  1364.       WHILE CHAR% <> -1
  1365. 21360    CALL GETCOM(Y$)
  1366.          IF Y$ = CANCEL$ THEN _
  1367.             GOTO 21560
  1368. 21380    CHECKSUM = (Y$ = NEGATIVE.ACKNOWLEDGE$)
  1369.          IF CHECKSUM THEN _
  1370.             FF = INSTR(INTERNAL.EQUIV$,"X") : _
  1371.             IF FF > 0 THEN _
  1372.                FT$ = MID$(DFLTXFER$,FF,1) : _
  1373.                GOTO 21480 _
  1374.             ELSE FT$ = "X" : _
  1375.                  GOTO 21480 _
  1376.          ELSE IF Y$ = "C" THEN _
  1377.                  GOTO 21480
  1378.          CALL EOFCOMM (CHAR%)
  1379. 21390 WEND
  1380.       GOSUB 21460
  1381.       IF FILESYS.PARAMETER > 1 THEN _
  1382.          RETURN
  1383.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1384.          RETURN
  1385.       CALL CHECKTIM (TRANSFER.ABORT!)
  1386.       ON SUBROUTINE.PARAMETER GOTO 21350,21455
  1387. 21410 CALL SETABORT (TRANSFER.ABORT!, WAIT.BEFORE.DISCONNECT)
  1388. '
  1389. ' *  ROUTINE TO WAIT FOR AN ACKNOWLEDGEMENT ON AN "XMODEM" OR "YMODEM"        *
  1390. ' *  DOWNLOAD                                                                 *
  1391. '
  1392. 21415 CALL EOFCOMM (CHAR%)
  1393.       IF CHAR% <> -1 THEN _
  1394.          GOTO 21420
  1395.       GOSUB 21460
  1396.       IF FILESYS.PARAMETER > 1 THEN _
  1397.          RETURN
  1398.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1399.          RETURN
  1400.       CALL CHECKTIM (TRANSFER.ABORT!)
  1401.       ON SUBROUTINE.PARAMETER GOTO 21415,21455
  1402. 21420 CALL GETCOM(Y$)
  1403.       IF Y$ = ACKNOWLEDGE$ THEN _
  1404.          GOTO 21470
  1405. 21440 IF Y$ <> NEGATIVE.ACKNOWLEDGE$ THEN _
  1406.          GOTO 21450
  1407. 21443 D$ = LINE.FEED$ + _
  1408.          "Error -> retrans #" + _
  1409.          STR$(SO)
  1410.       GOSUB 21710
  1411.       IF FILESYS.PARAMETER > 1 THEN _
  1412.          RETURN
  1413. 21445 SO = SO - 1
  1414.       GOTO 21490
  1415. 21450 IF Y$ = CANCEL$ THEN _
  1416.          IF HAVE.A.CANCEL THEN _
  1417.             GOTO 21560 _
  1418.          ELSE HAVE.A.CANCEL = TRUE
  1419.       CALL CHECKTIM (TRANSFER.ABORT!)
  1420.       ON SUBROUTINE.PARAMETER GOTO 21415,21455
  1421. 21455 D$ = "Download timeout"
  1422.       GOSUB 21710
  1423.       IF FILESYS.PARAMETER > 1 THEN _
  1424.          RETURN
  1425.       GOTO 21560
  1426. 21460 CALL CARRIER
  1427.       CALL FINDFUNC
  1428.       IF SUBROUTINE.PARAMETER < 0 THEN _
  1429.          FILESYS.PARAMETER = 7 : _
  1430.          RETURN
  1431.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1432.          GOTO 21540
  1433.       RETURN
  1434. '
  1435. ' *  DISPLAY BLOCK SENT OK AND THEN READ IN NEXT RECORD FROM DISK TO DOWNLOAD *
  1436. '
  1437. 21470 CALL QLPRNT ("OK Sent Blk #",SO)
  1438. 21480 IF LOC(2) => MAX.BLOCK THEN _
  1439.          GOTO 21530
  1440.       CALL GETWORK (FLEN)
  1441.       IF EC <> 0 THEN _
  1442.          EL = 21480 : _
  1443.          GOTO 21900
  1444.       SEC = 255 AND (SEC + 1)
  1445.       GOTO 21490
  1446. '
  1447. ' *  ROUTINE TO WRITE OUT AN "XMODEM" OR "YMODEM" RECORD TO THE COMM. PORT    *
  1448. '
  1449. 21490 SO = SO + 1
  1450.       CALL PUTCOM (START.OF.HEADER$ + CHR$(SEC) + CHR$(SEC XOR 255))
  1451.       CALL PUTCOM (DOWNLOAD.RECORD$)
  1452.       HAVE.A.CANCEL = FALSE
  1453. 21503 WK$ = DOWNLOAD.RECORD$
  1454. 21504 GOSUB 21750
  1455.       IF FILESYS.PARAMETER > 1 THEN _
  1456.          RETURN
  1457. 21510 IF CHECKSUM THEN _
  1458.          CALL PUTCOM(CHR$(XMODEM.CHECKSUM)) _
  1459.       ELSE CALL PUTCOM(CHR$(CRC.HIGH) + CHR$(CRC.LOW))
  1460.       GOSUB 21280
  1461.       IF FILESYS.PARAMETER > 1 THEN _
  1462.          RETURN
  1463.       GOTO 21410
  1464. '
  1465. ' *  END-OF-FILE FOR XMODEM DOWNLOADS -- SEND THE "EOT" CHARACTER AND WAIT UP *
  1466. ' *  TO 2 SECONDS FOR A POSITIVE RESPONSE (I.E. AN "ACK").  IF NONE IS        *
  1467. ' *  RE-TRY UP TO 10 TIMES.  IF NO POSITIVE RESPONSE IS RECEIVED AFTER TEN    *
  1468. ' *  ATTEMPTS, ASSUME THE DOWNLOAD WAS UNSUCCESSFULL.                         *
  1469. '
  1470. 21530 CALL PUTCOM (END.TRANSMISSION$)
  1471.       X = 1
  1472. 21531 GOSUB 20810
  1473.       IF FILESYS.PARAMETER > 1 THEN _
  1474.          RETURN
  1475.       IF INSTR(Y$,ACKNOWLEDGE$) THEN _
  1476.          GOTO 21550
  1477.       CALL FINDFUNC
  1478.       IF SUBROUTINE.PARAMETER < 0 THEN _
  1479.          FILESYS.PARAMETER = 2 : _
  1480.          RETURN
  1481.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1482.          GOSUB 21540 : _
  1483.          GOTO 21545
  1484.       IF X < 10 THEN _
  1485.          X = X + 1 : _
  1486.          GOTO 21531
  1487.       DOWNLOAD.COMPLETED = FALSE
  1488.       GOTO 21230
  1489. 21540 GOSUB 20510
  1490.       IF FILESYS.PARAMETER > 1 THEN _
  1491.          RETURN
  1492.       RETURN
  1493. 21545 Y$ = CANCEL$
  1494.       CALL PUTCOM (CANCEL$ + CANCEL$ + CANCEL$)
  1495.       DOWNLOAD.COMPLETED = FALSE
  1496.       GOTO 21250
  1497. 21550 DOWNLOAD.COMPLETED = TRUE
  1498.       GOTO 21250
  1499. 21560 DOWNLOAD.COMPLETED = FALSE
  1500.       D$ = LINE.FEED$ + _
  1501.            "Caller aborted trans"
  1502.       GOSUB 21710
  1503.       IF FILESYS.PARAMETER > 1 THEN _
  1504.          RETURN
  1505.       GOTO 21545
  1506. '
  1507. ' Exit to main-line RBBS-PC and go to handle exit (line  202)
  1508. '
  1509. '21570 FILESYS.PARAMETER = 2
  1510. '      GOTO 21920
  1511. '
  1512. ' Exit to main-line RBBS-PC and go to command processing (line 1200)
  1513. '
  1514. '21580 FILESYS.PARAMETER = 3
  1515. '      GOTO 21920
  1516. '
  1517. ' Exit to main-line RBBS-PC and deny the user access (line 1380)
  1518. '
  1519. '21590 FILESYS.PARAMETER = 4
  1520. '      GOTO 21920
  1521. '
  1522. ' Exit to put in extended description and then return (line 2008)
  1523. '
  1524. '21600 FILESYS.PARAMETER = 5
  1525. '      GOTO 21920
  1526. '
  1527. ' Exit to main-line RBBS-PC because time limit exceeded (line 10553)
  1528. '
  1529. '21610 FILESYS.PARAMETER = 6
  1530. '      GOTO 21920
  1531. '
  1532. ' Exit to main-line RBBS-PC because loss of carrier (line 10595)
  1533. '
  1534. '21620 FILESYS.PARAMETER = 7
  1535. '      GOTO 21920
  1536. '
  1537. ' STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL OUTPUT ROUTIN
  1538. '
  1539. ' Modeled on lines 12975 to 12983 in RBBS-PC.BAS
  1540. 21630 SUBROUTINE.PARAMETER = 1
  1541.       GOTO 21655
  1542. 21640 SUBROUTINE.PARAMETER = 3
  1543.       GOTO 21655
  1544. 21650 SUBROUTINE.PARAMETER = 5
  1545. 21655 CALL TPUT
  1546.       IF SUBROUTINE.PARAMETER < 0 THEN _
  1547.          FILESYS.PARAMETER = 2 : _
  1548.          RETURN
  1549.       IF SUBROUTINE.PARAMETER = 8 THEN _
  1550.          GOSUB 21660
  1551.       RETURN
  1552. '
  1553. ' STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL INPUT ROUTINE
  1554. '
  1555. ' Modeled on lines 12995 to 12997 in RBBS-PC.BAS
  1556. 21660 SUBROUTINE.PARAMETER = 1
  1557.       CALL TGET
  1558.       IF SUBROUTINE.PARAMETER < 0 THEN _
  1559.          FILESYS.PARAMETER = 2
  1560.       RETURN
  1561. 21700 EC = 0
  1562.       RETURN
  1563. '
  1564. ' **** COMMON LOCAL DISPLAY PRINT ****
  1565. '
  1566. '  (formerly lines 1315 to 1320 in RBBS-PC.BAS CPC16-1A
  1567. 21710 NUM.RETURNS = 1
  1568. 21720 CALL LPRNT (D$,NUM.RETURNS)
  1569.       RETURN
  1570. '
  1571. ' *  XMODEM / CRC INTERFACE                                                   *
  1572. '
  1573. '  (formerly line 46000 in RBBS-PC.BAS CPC16-1A
  1574. 21750 XMODEM.CHECKSUM = 0
  1575.       CRC.VALUE = 0
  1576.       CALL XMODEM(WK$,XMODEM.CHECKSUM,CRC.VALUE,CRC.HIGH,CRC.LOW)
  1577.       RETURN
  1578. '
  1579. ' * UPDATE DOWNLOAD STATISTICS                                                *
  1580. '
  1581. '  (formerly lines 50600 to 50614 in RBBS-PC.BAS CPC16-1A
  1582. 21760 GOSUB 21780
  1583.       IF FILESYS.PARAMETER > 1 THEN _
  1584.          RETURN
  1585.  IF BATCH.TRANSFER THEN _
  1586.          CALL LINESNFIL (NODE.WORK.FILE$,DOWN.FILES) _               ' KG101603
  1587. ELSE DOWN.FILES = 1
  1588.       IF NOT DOWNLOAD.COMPLETED THEN _
  1589.          DF$ = " Aborted" _
  1590.       ELSE CALL LOGDOWN (PERSONAL.DOWNLOAD,DWN.INDEX) : _
  1591.            DOWNLOADS = DOWNLOADS + DOWN.FILES : _                    ' KG101603
  1592.            GLOBAL.DOWNLOADS = GLOBAL.DOWNLOADS + DOWN.FILES : _      ' KG102004
  1593.            DLBYTES! = DLBYTES! + NUM.DNLD.BYTS! : _
  1594.            GLOBAL.DLBYTES! = GLOBAL.DLBYTES! + NUM.DNLD.BYTS! : _    ' KG102004
  1595.            DL.TODAY! = DL.TODAY! + DOWN.FILES : _                    ' KG102004
  1596.     GLOBAL.DL.TODAY! = GLOBAL.DL.TODAY! + DOWN.FILES : _     'PE01/07/88
  1597.            BYTES.TODAY! = BYTES.TODAY! + NUM.DNLD.BYTS! : _
  1598.            GLOBAL.BYTES.TODAY! = GLOBAL.BYTES.TODAY! + NUM.DNLD.BYTS! : _ KG102004
  1599.            NUM.DNLD.BYTS! = 0 : _
  1600.            DF$ = " Downloaded" : _
  1601.            IF (DWN.INDEX = LAST.DOWNLOAD OR NOT CONCAT.FILES) THEN _
  1602.               CALL SKIPLINE (1) : _
  1603.               CALL QTPUT ("Download successful",1)
  1604.       'IF AUTODOWNLOAD.IN.PROGRESS THEN _
  1605.       '   DF$ = " AUTO" + _
  1606.       '        MID$(N$,2)
  1607.       IF INSTR(N$,"Aborted") THEN _
  1608.          AUTODOWNLOAD.IN.PROGRESS = 0
  1609.       A$ = ""
  1610. 21770 SUBROUTINE.PARAMETER = 2
  1611.       CALL AMORPM
  1612.      IF NOT BATCH.TRANSFER THEN _
  1613.       GOTO 21773
  1614.       CALL OPENWORK (NODE.WORK.FILE$)
  1615.       IF EC > 0 THEN _
  1616.          RETURN
  1617.       Q = 0
  1618.       WHILE NOT EOF(2)
  1619.          CALL READANY
  1620.          Q = Q + 1
  1621.          B$(Q) = A$
  1622.       WEND
  1623. 21772 IF Q < 1 THEN _        
  1624.          BATCH.TRANSFER = FALSE :_
  1625.        CALL CHECKRATIO (FALSE):_
  1626.        RETURN
  1627.       CALL OPENWORK (B$(Q))
  1628.       IF EC > 0 THEN _
  1629.          EC = 0 : _
  1630.          Q = Q - 1 : _
  1631.          GOTO 21772
  1632.       BYTES.IN.FILE# = LOF(2)
  1633.       FILE.NAME$ = B$(Q)
  1634. 21773 CALL BRKFNAME (FILE.NAME$,DR$,X$,EXTENTION$,TRUE)
  1635.       Z$ = X$ + _
  1636.            EXTENTION$ + _
  1637.            DF$ + _
  1638.            " at " + _
  1639.            TIM$ + _
  1640.            " using " + _
  1641.            FT$ + _
  1642.            STR$(BYTES.IN.FILE#)
  1643.       CALL UPDTCALR (Z$,2)
  1644.       IF BATCH.TRANSFER THEN _
  1645.          Q = Q - 1 : _
  1646.          GOTO 21772
  1647.       CALL CHECKRATIO (FALSE)
  1648. 21774 IF MENU.INDEX = 6 THEN _
  1649.          IF DOWNLOAD.COMPLETED THEN _
  1650.             A$ = X$ : _
  1651.             SUBROUTINE.PARAMETER = 5 : _
  1652.             CALL LIBRARY
  1653.       RETURN
  1654. '
  1655. ' *****   TURN ON INTERMEDIATE ECHO   *****
  1656. '
  1657. '  (formerly line 50620 in RBBS-PC.BAS CPC16-1A
  1658. 21780 IF ECHOER$ = "I" THEN _
  1659.          CALL SETECHO ("I")
  1660. '
  1661. ' *  RESTORE COMMUNICATIONS AFTER SWITCH TO 8 BIT                             *
  1662. '
  1663. '  (formerly between lines 50620 and 50630 in RBBS-PC.BAS CPC16-1A
  1664.       IF SWITCHED.TO.EIGHT THEN _
  1665.          IF SWITCH.BACK THEN _
  1666.             OUT LINE.CONTROL.REGISTER, PREV.LINE.CONTROL : _
  1667.             CALL DELAYIT (3) : _
  1668.             EIGHT.BIT = FALSE : _
  1669.             SWITCHED.TO.EIGHT = FALSE
  1670.       RETURN
  1671. '
  1672. ' *****  TURN OFF INTERMEDIATE ECHO  *****
  1673. '
  1674. '  (formerly line 50630 in RBBS-PC.BAS CPC16-1A
  1675. 21790 IF ECHOER$ = "I" THEN _
  1676.          CALL SETECHO ("R")
  1677.       RETURN
  1678. '
  1679. ' *****   DIRECTORY SEARCH   *****
  1680. '
  1681. '  (formerly lines 52900 to 52920 in RBBS-PC.BAS CPC16-1A
  1682. 21800 CK = 2
  1683.       IF Q > 1 THEN _
  1684.          GOTO 21820
  1685. 21810 A$ = "Search for (in file name/desc, wildcards name only, [ENTER] quits)"
  1686.       GOSUB 21660
  1687.       IF FILESYS.PARAMETER > 1 THEN _
  1688.          RETURN
  1689.       IF Q = 0 THEN _
  1690.          RETURN
  1691.       B$(2) = B$(1)
  1692. 21820 RS$ = B$(2)
  1693.       WILD.SEARCH = (INSTR(RS$,"*") > 0 OR INSTR(RS$,"?") > 0)
  1694.       CALL ALLCAPS (RS$)
  1695.       SEARCH.STRING$ = RS$
  1696.       SEARCH.DATE$ = ""
  1697.       A1$ = RS$
  1698.       GOTO 21867
  1699. '
  1700. ' *****  P - personal download  *****
  1701. '
  1702. '  (formerly lines 52950 to 52952 in RBBS-PC.BAS CPC16-1A
  1703. 21850 IF PERSONAL.BEGIN < 1 OR PERSONAL.LEN < 1 THEN _
  1704.          RETURN
  1705.       DOWNLOAD.FLAG = 0
  1706.       PERSONAL.DOWNLOAD = TRUE
  1707. 21852 CALL PERSFILE (MID$(USER.RECORD$,PERSONAL.BEGIN,PERSONAL.LEN),_
  1708.                      DOWNLOAD.FLAG)
  1709.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1710.       FILESYS.PARAMETER = 7 : _
  1711.          RETURN
  1712.       IF Q <= 0 THEN _
  1713.          GOTO 21854
  1714.       CONCAT.FILES = PERSONAL.CONCAT
  1715.       STOP.INTERRUPTS = TRUE
  1716.       TIME.LOCK.EXEMPT = TRUE
  1717.       GOSUB 20202
  1718.       IF FILESYS.PARAMETER > 1 THEN _
  1719.          GOTO 21854
  1720.       TIME.LOCK.EXEMPT = FALSE
  1721.       CONCAT.FILES = FALSE
  1722.       GOTO 21852
  1723. 21854 PERSONAL.DOWNLOAD = FALSE
  1724.       RETURN
  1725. '
  1726. ' *  N - COMMAND FROM FILES MENU (DISPLAY NEW FILES SINCE LAST DIR DISPLAY)   *
  1727. '
  1728. '  (formerly lines 53000 to 53070 in RBBS-PC.BAS CPC16-1A
  1729. 21860 CK = 1
  1730.       IF Q > 1 THEN _
  1731.          GOTO 21865
  1732. 21862 A1$ = RIGHT$(LM$,4) +_
  1733.             LEFT$(LM$,2)
  1734.       A$ = "Files on/after (MMDDYY, [ENTER] = last on " + _
  1735.            A1$ + _
  1736.            ")"
  1737.       GOSUB 21660
  1738.       IF FILESYS.PARAMETER > 1 THEN _
  1739.          RETURN
  1740.       IF Q = 0 THEN _
  1741.          RS$ = LM$ : _
  1742.          GOTO 21866
  1743.       B$(2) = B$(1)
  1744. 21865 IF LEN(B$(2)) <> 6 THEN _
  1745.          GOTO 21862
  1746.       A1$ = B$(2)
  1747.       RS$ = RIGHT$(A1$,2) + _
  1748.             LEFT$(A1$,4)
  1749. 21866 SEARCH.DATE$ = RS$
  1750.       SEARCH.STRING$ = ""
  1751. 21867 IF Q > 2 THEN _
  1752.          DIR.INDEX = 3 : _
  1753.          GOTO 21871
  1754. ' *************************************************
  1755. '  NEXT 3 lines comment out to bypass DATE Question
  1756. ' REMOVE (') to restore to ORIG
  1757. '****************************************************
  1758. 21870 'CALL GETDIRS (NOT EXPERT.USER)   '<=====
  1759.       'IF Q = 0 THEN _                  '<====
  1760.        '  RETURN                        '<====
  1761.       DIR.INDEX = 1
  1762. '**************************************************
  1763. ' DELETE the B$(1) = "ALL" DO NOT DELETE THE LINE NUMBER
  1764. '      ..just move it Down one
  1765. '**************************************************
  1766. 21871 B$(1) = "ALL"      'added Pete '<=========
  1767.       CALL CONVDIRS (DIR.INDEX)
  1768.       LAST.DIR.POS = Q
  1769.       LIST.DIRECTORY = TRUE
  1770.       LIST.NEW = TRUE
  1771. 21875 Z$ = B$(DIR.INDEX)
  1772.       IF Z$ = "ALL" THEN _
  1773.          IF NOT LIMIT.SEARCH.TO.FMS THEN _
  1774.             GOTO 21890
  1775. 21880 LIST.INDEX = DIR.INDEX
  1776.       QX = LIST.INDEX
  1777.       GOSUB 20160
  1778.       IF FILESYS.PARAMETER > 1 THEN _
  1779.          RETURN
  1780.       DIR.INDEX = DIR.INDEX + 1
  1781.       IF DIR.INDEX <= LAST.DIR.POS THEN _
  1782.          GOTO 21875
  1783.       LIST.NEW = FALSE
  1784.       SEARCH.STRING$ = ""
  1785.       SEARCH.DATE$ = ""
  1786.       RETURN
  1787. 21890 G = DIR.INDEX
  1788.       LIST.INDEX = DIRECTORY.INDEX + 1
  1789.       CALL GETALL (DIRECTORY.PATH$ + DIRECTORY.PREFIX$ + "." + DIRECTORY.EXTENTION$,B$(),DIRECTORY.EXTENTION$,G)
  1790.       SEARCHING.ALL = TRUE
  1791.       QX = G
  1792.       LIST.INDEX = DIR.INDEX + 1
  1793.       GOTO 20160
  1794. '
  1795. ' *  MAIN FILE SYSTEM ERROR TRAP - ALL ERRORS PASS THROUGH THIS ROUTINE
  1796. '
  1797. '  (formerly lines 13000 to 13500 in RBBS-PC.BAS CPC16-1A
  1798. 21900 IF DEBUG THEN _
  1799.          A$ = "RBBSSUB5 DEBUG Error Trap Entry ERL=" + _
  1800.               STR$(EL) + _
  1801.               " ERR=" + _
  1802.               STR$(EC) : _
  1803.          IF PRINTER THEN _
  1804.             CALL PRINTIT(A$) _
  1805.          ELSE CALL LPRNT(A$,1)
  1806.       IF EL = 20126 AND EC = 53 THEN _
  1807.          GOTO 20142
  1808.       IF EL = 20242 AND EC = 62 THEN _
  1809.          CALL UPDTCALR (FILESEC.FILE$ + " bad format!",2) : _
  1810.          GOTO 20247
  1811.       IF EL = 20262 THEN _
  1812.          A$ = "<Download aborted>" : _
  1813.          DOWNLOAD.COMPLETED = FALSE : _
  1814.          GOTO 20390
  1815.       IF EL = 20452 AND EC = 53 THEN _
  1816.          GOTO 20451
  1817.       IF EL = 20560 AND EC = 67 THEN _
  1818.          GOTO 20451
  1819.       IF EL = 20560 AND EC = 70 THEN _
  1820.          IF VAL(FREE.SPACE$) > 1999 THEN _
  1821.             GOTO 20610 _
  1822.          ELSE CALL QTPUT ("No room for uploads. Try tomorrow.",1) : _
  1823.               GOTO 21700
  1824.       IF EL = 20620 THEN _
  1825.          GOTO 20670
  1826.       IF EL = 20650 THEN _
  1827.          GOTO 20670
  1828.       IF EL = 20736 AND EC = 53 THEN _
  1829.          GOTO 21700
  1830.       IF EL = 20900 AND EC = 75 THEN _
  1831.          GOTO 21230
  1832.       IF EL = 20900 AND EC = 70 THEN _
  1833.          CALL QTPUT ("No room for uploads. Try tomorrow.",1) : _
  1834.          GOTO 21230
  1835.       IF EL = 21131 OR EL = 21220 THEN _
  1836.          EC = 0 : _
  1837.          GOTO 21230
  1838.       IF EL = 21480 THEN _
  1839.          CALL LOGERROR : _
  1840.          IF EC = 57 THEN _
  1841.             CALL QTPUT("Error reading file.  Aborting download",1) : _
  1842.             DOWNLOAD.COMPLETED = FALSE : _
  1843.             GOTO 21230
  1844. 21910 CALL LOGERROR
  1845.       CALL QTPUT (CALLERS.RECORD$,1)
  1846.       FILESYS.PARAMETER = 3
  1847.       RETURN
  1848. 21920 ' EXIT RBBS-PC FILE SUBSYSTEM
  1849.       END SUB
  1850. ' $SUBTITLE: 'GETCOLOR - subroutine to see if user wants color'
  1851. ' $PAGE
  1852. '
  1853.   SUB GETCOLOR STATIC
  1854. '******************************************************************************
  1855. '* Find out if user wants COLOR before getting name                           *
  1856. '*                                                                            *
  1857. '* The color values are as follows                                            *
  1858. '* CX$(1)= red   CX$(2) = GREEN      CX$(3) = YELLOW       CX$(4) = BLUE      *
  1859. '* CX$(5)= MAGENTA  CX$(6) = CYAN   CX$(7) = WHITE       CX$(8)= BRT.WHITE    *
  1860. '*                                                                            *
  1861. '******************************************************************************
  1862. '
  1863. 21935 'CALL SKIPLINE(2)
  1864.     'A$ = CHR$(7)+"Do you want IBM Color (Y/[N]) "
  1865.     'TURBO.KEY = T.KEY
  1866.     'CALL TGET
  1867.     'IF Q = 0 THEN_
  1868.     '  GOTO 21940
  1869.     'IF NOT YES THEN GOTO 21940
  1870.    IF GR < 2  then GOTO 21940
  1871.     CX$(1) = CHR$(27) + "[01;31;40m": CX$(2) = CHR$(27) + "[01;32;40m"
  1872.     CX$(3) = CHR$(27) + "[01;33;40m": CX$(4) = CHR$(27) + "[01;34;40m"
  1873.     CX$(5) = CHR$(27) + "[01;35;40m": CX$(6) = CHR$(27) + "[01;36;40m"
  1874.     CX$(7) = CHR$(27) + "[01;37;40m": CX$(8) = CHR$(27) + "[01;37;40m"
  1875.     EXIT SUB
  1876. '
  1877. '******************************************************************************
  1878. '*  Turn Off Color if User does Not want it                                   *
  1879. '******************************************************************************
  1880. '
  1881. 21940
  1882. CX$(1) = "": CX$(2) = "": CX$(3) = "": CX$(4) = "": CX$(5) = ""
  1883. CX$(6) = "": CX$(7) = "": CX$(8) = ""
  1884. END SUB
  1885. '******************** INSERTED AUTO.LOGOFF here ******************
  1886. '
  1887. ' $SUBTITLE: 'AUTOLOGOFF - Subroutine to  to log off after transfer'
  1888. ' $PAGE
  1889. '
  1890.   SUB AUTOLOGOFF STATIC
  1891.  AUTO.END = 0
  1892.   IF GET.EXT.DESC = TRUE THEN _
  1893.     EXIT SUB
  1894.  SUBROUTINE.PARAMETER = 1
  1895.    A$ = CHR$(7)+CX$(2)+"Would you like me to"+_
  1896.         CX$(5)+" Log you Off"+CX$(2)+" after the transfer"+_
  1897.         CX$(3)+" ?(Y/[N]) "+CX$(7)+CHR$(7)
  1898. CALL QTPUT(A$,0)
  1899.      A$=""
  1900.     TURBO.KEY = -TURBO.KEY.USER
  1901.       CALL TGET
  1902.        IF NOT YES THEN _
  1903.      EXIT SUB 
  1904.  AUTO.END = 1
  1905. END SUB
  1906. ' $SUBTITLE: 'DOORRTN - Subroutine to process requests from a door'
  1907. ' $PAGE
  1908. '
  1909. '  SUBROUTINE NAME    -- DOORRTN
  1910. '
  1911. '  INPUT PARAMETERS   -- PARAMETER                      MEANING
  1912. '                        DOUTx.DEF               File of requests
  1913. '
  1914. '  OUTPUT PARAMETERS  -- USER.SECURITY.LEVEL     Revised Security Level
  1915. '
  1916. '  SUBROUTINE PURPOSE -- To give Doors a stable way to make requests
  1917. '                        to the host.
  1918. '
  1919. 63100 SUB DOORRTN STATIC                                             ' KG120502
  1920.       IF NOT EXIT.TO.DOORS THEN _                                    ' KG120502
  1921.          EXIT SUB                                                    ' KG120502
  1922.       FILE.NAME$ = "DOUT" + NODE.ID$ + ".DEF"                        ' KG120502
  1923.       CALL FINDIT (FILE.NAME$)                                       ' KG120502
  1924.       IF NOT OK THEN _                                               ' KG120502
  1925.          EXIT SUB                                                    ' KG120502
  1926. 63105 IF EOF(2) THEN _                                               ' KG120502
  1927.          GOTO 63115                                                  ' KG120502
  1928.       CALL READPARMS (A$(),2,1)                                      ' KG120502
  1929.       IF EC > 0 THEN _                                               ' KG120502
  1930.          GOTO 63115                                                  ' KG120502
  1931.       IF LEN(A$(1)) <> 2 THEN _                                      ' KG120502
  1932.          EXIT SUB                                                    ' KG120502
  1933.       X = INSTR("SL,",A$(1) + ",")                                   ' KG120502
  1934.       IF X = 0 THEN _                                                ' KG120502
  1935.          GOTO 63105                                                  ' KG120502
  1936.       X = X\3 + 1                                                    ' KG120502
  1937.       ON X GOTO 63110                                                ' KG120502
  1938.       GOTO 63105                                                     ' KG120502
  1939. 63110 X$ = LEFT$(A$(2),1)                                            ' KG120502
  1940.       CALL CHECKINT (A$(2))                                          ' KG120502
  1941.       IF EC > 0 THEN _                                               ' KG120502
  1942.          GOTO 63115                                                  ' KG120502
  1943.       IF X$ = "+" OR X$ = "-" THEN _                                 ' KG120502
  1944.          A = USER.SECURITY.LEVEL + TESTED.INTEGER.VALUE _            ' KG120502
  1945.       ELSE A = TESTED.INTEGER.VALUE                                  ' KG120502
  1946.       IF A < SYSOP.SECURITY.LEVEL THEN _                             ' KG120502
  1947.          USER.SECURITY.LEVEL = A : _                                 ' KG120502
  1948.          USER.SECURITY.SAVE = A : _                                  ' KG120502
  1949.          ADJUSTED.SECURITY = TRUE : _                                ' KG120502
  1950.          CALL QTPUT ("Security changed to" + STR$(A),1) : _          ' KG122401
  1951.          CALL CALLOPT : _                                            ' KG122401
  1952.          CALL UPDTCALR ("Door reset security to "+A$(2),2)           ' KG120502
  1953.       GOTO 63105                                                     ' KG120502
  1954. 63115 CALL KILLWORK (FILE.NAME$)                                     ' KG120502
  1955.       EC = 0                                                         ' KG120502
  1956.       END SUB                                                        ' KG120502
  1957.